1unit AssemblerDlg; 2 3{$mode objfpc}{$H+} 4 5interface 6 7uses 8 Classes, SysUtils, Forms, Controls, Graphics, 9 IDEWindowIntf, DbgIntfBaseTypes, DbgIntfDebuggerBase, 10 ComCtrls, StdCtrls, ExtCtrls, LclType, LCLIntf, DebuggerDlg, Debugger, 11 BaseDebugManager, EditorOptions, Math, types, LCLProc, Menus, Clipbrd, ActnList, 12 IDECommands, IDEImagesIntf, CodeToolManager, CodeCache, SourceEditor; 13 14type 15 16 { TAssemblerDlg } 17 18 TAsmDlgLineMapState = ( 19 lmsUnknown, 20 lmsInvalid, // debugger couldn't disassemble this address 21 lmsStatement, // display line as assembler 22 lmsSource, // display line as source 23 lmsFuncName // Name of function 24 ); 25 26 TAsmDlgLineEntry = record 27 State: TAsmDlgLineMapState; 28 Addr: TDbgPtr; 29 Offset: Integer; 30 Dump: String; 31 Statement: String; 32 PasCode: String; 33 FileName, FullFileName: String; 34 SourceLine: Integer; 35 ImageIndex: Integer; 36 end; 37 TAsmDlgLineEntries = Array of TAsmDlgLineEntry; 38 39 40 TAssemblerDlg = class(TDebuggerDlg) 41 actCurrentInstr: TAction; 42 actGotoAddr: TAction; 43 actCopy: TAction; 44 actStepOverInstr: TAction; 45 actStepIntoInstr: TAction; 46 ActionList1: TActionList; 47 CopyToClipboard: TMenuItem; 48 EditGotoAddr: TEdit; 49 ImageList1: TImageList; 50 pnlToolAddr: TPanel; 51 pbAsm: TPaintBox; 52 PopupMenu1: TPopupMenu; 53 sbHorizontal: TScrollBar; 54 sbVertical: TScrollBar; 55 Timer1: TTimer; 56 ToolBar1: TToolBar; 57 ToolButton1: TToolButton; 58 ToolButtonCopy: TToolButton; 59 ToolButtonGoto: TToolButton; 60 ToolButtonGotoCurrent: TToolButton; 61 ToolButtonStepOverInstr: TToolButton; 62 ToolButtonStepIntoInstr: TToolButton; 63 ToolButton4: TToolButton; 64 ToolButtonPower: TToolButton; 65 ToolButton2: TToolButton; 66 procedure actCurrentInstrExecute(Sender: TObject); 67 procedure actGotoAddrExecute(Sender: TObject); 68 procedure actStepIntoInstrExecute(Sender: TObject); 69 procedure actStepOverInstrExecute(Sender: TObject); 70 procedure CopyToClipboardClick(Sender: TObject); 71 procedure EditGotoAddrChange(Sender: TObject); 72 procedure EditGotoAddrKeyPress(Sender: TObject; var Key: char); 73 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 74 procedure FormResize(Sender: TObject); 75 procedure pbAsmClick(Sender: TObject); 76 procedure pbAsmMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; {%H-}X, Y: Integer); 77 procedure pbAsmMouseMove(Sender: TObject; {%H-}Shift: TShiftState; {%H-}X, Y: Integer); 78 procedure pbAsmMouseUp(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, 79 {%H-}Y: Integer); 80 procedure pbAsmMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; {%H-}MousePos: TPoint; var Handled: Boolean); 81 procedure pbAsmPaint(Sender: TObject); 82 procedure sbHorizontalChange(Sender: TObject); 83 procedure sbVerticalChange(Sender: TObject); 84 procedure sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); 85 procedure Timer1Timer(Sender: TObject); 86 procedure ToolButtonPowerClick(Sender: TObject); 87 private 88 FWheelAccu: Integer; 89 FDebugger: TDebuggerIntf; 90 FDebugManager: TBaseDebugManager; 91 FDisassembler: TIDEDisassembler; 92 FDisassemblerNotification: TIDEDisassemblerNotification; 93 FCurrentLocation: TDBGPtr; // current view location (lines are relative to this location) 94 FLocation: TDBGPtr; // the actual PC, green "=>" execution mark 95 FMouseIsDown: Boolean; 96 FIsVScrollTrack: Boolean; 97 FVScrollCounter, FVScrollPos: Integer; 98 99 FTopLine: Integer; 100 FLastTopLine: Integer; 101 FLastTopLineIdx: Integer; 102 FLastTopLineIsSrc: Boolean; // The Source In Fron of Idx 103 FLastTopLineValid: Boolean; 104 105 FSelectLine: Integer; 106 FSelectionEndLine: Integer; 107 FLineCount: Integer; 108 FLineMap: TAsmDlgLineEntries; 109 110 FLineHeight: Integer; 111 FCharWidth: Integer; 112 FGutterWidth: Integer; 113 FUpdating: Boolean; 114 FUpdateNeeded, FVisibleChanged: Boolean; 115 116 FPowerImgIdx, FPowerImgIdxGrey: Integer; 117 FCurLineImgIdx: Integer; 118 FImgSourceLine: Integer; 119 FImgNoSourceLine: Integer; 120 121 procedure BreakPointChanged(const {%H-}ASender: TIDEBreakPoints; 122 const {%H-}ABreakpoint: TIDEBreakPoint); 123 function GetBreakpointFor(AnAsmDlgLineEntry: TAsmDlgLineEntry): TIDEBreakPoint; 124 procedure CheckImageIndexFor(var AnAsmDlgLineEntry: TAsmDlgLineEntry); 125 procedure DoDebuggerDestroyed(Sender: TObject); 126 procedure ClearLineMap(AState: TAsmDlgLineMapState = lmsUnknown); 127 procedure ClearImageIdx; 128 procedure DisassemblerChanged(Sender: TObject); 129 procedure SetDisassembler(const AValue: TIDEDisassembler); 130 procedure SetDebugger(const AValue: TDebuggerIntf); 131 function FormatLine(ALine: TAsmDlgLineEntry; W: Integer): String; 132 procedure UpdateView; 133 procedure UpdateActionEnabled; 134 procedure UpdateLineData; 135 procedure UpdateLineDataEx(ALineMap: TAsmDlgLineEntries; 136 AFirstLine, ALineCount: Integer; 137 var ACachedLine, ACachedIdx: Integer; 138 var ACachedIsSrc, ACachedValid: Boolean; 139 ACachedUpdate: Boolean; 140 ANoExtraHeader: Boolean = False 141 ); 142 procedure SetSelection(ALine: Integer; AMakeVisible: Boolean; AKeepSelEnd: Boolean = False); 143 procedure SetLineCount(ALineCount: Integer); 144 procedure SetTopLine(ALine: Integer); 145 function IndexOfAddr(const AnAddr: TDBGPtr): Integer; 146 procedure UpdateLocation(const AAddr: TDBGPtr); 147 procedure DoEditorOptsChanged(Sender: TObject; Restore: boolean); 148 protected 149 function GetSourceCodeLine(SrcFileName: string; SrcLineNumber: Integer): string; 150 procedure DoBeginUpdate; override; 151 procedure DoEndUpdate; override; 152 procedure UpdateShowing; override; 153 public 154 constructor Create(AOwner: TComponent); override; 155 destructor Destroy; override; 156 157 procedure SetLocation(ADebugger: TDebuggerIntf; const AAddr: TDBGPtr; const ADispAddr: TDBGPtr = 0); 158 property Disassembler: TIDEDisassembler read FDisassembler write SetDisassembler; 159 property DebugManager: TBaseDebugManager read FDebugManager write FDebugManager; 160 property BreakPoints; 161 end; 162 163implementation 164 165{$R *.lfm} 166 167uses 168 LazarusIDEStrConsts; 169 170var 171 AsmWindowCreator: TIDEWindowCreator; 172 173{ TAssemblerDlg } 174 175procedure TAssemblerDlg.ClearLineMap(AState: TAsmDlgLineMapState = lmsUnknown); 176var 177 n: Integer; 178begin 179 FLastTopLineValid := False; 180 for n := Low(FLineMap) to High(FLineMap) do 181 begin 182 FLineMap[n].State := AState; 183 FLineMap[n].Dump := ''; 184 FLineMap[n].Statement := ''; 185 FLineMap[n].ImageIndex := -1; 186 FLineMap[n].Offset := 0; 187 if AState = lmsUnknown 188 then FLineMap[n].Addr := 0; 189 end; 190end; 191 192procedure TAssemblerDlg.ClearImageIdx; 193var 194 n: Integer; 195begin 196 FLastTopLineValid := False; 197 for n := Low(FLineMap) to High(FLineMap) do 198 begin 199 FLineMap[n].ImageIndex := -1; 200 end; 201end; 202 203procedure TAssemblerDlg.SetDisassembler(const AValue: TIDEDisassembler); 204begin 205 if FDisassembler = AValue then exit; 206 BeginUpdate; 207 try 208 if FDisassembler <> nil 209 then begin 210 FDisassembler.RemoveNotification(FDisassemblerNotification); 211 end; 212 213 FDisassembler := AValue; 214 215 if FDisassembler <> nil 216 then begin 217 FDisassembler.AddNotification(FDisassemblerNotification); 218 end; 219 220 DisassemblerChanged(FDisassembler); 221 finally 222 EndUpdate; 223 end; 224 UpdateActionEnabled; 225end; 226 227procedure TAssemblerDlg.SetDebugger(const AValue: TDebuggerIntf); 228begin 229 if FDebugger = AValue 230 then exit; 231 232 if FDebugger <> nil 233 then FDebugger.RemoveNotifyEvent(dnrDestroy, @DoDebuggerDestroyed); 234 FDebugger := AValue; 235 if FDebugger <> nil 236 then FDebugger.AddNotifyEvent(dnrDestroy, @DoDebuggerDestroyed); 237 UpdateActionEnabled; 238end; 239 240constructor TAssemblerDlg.Create(AOwner: TComponent); 241begin 242 FCurrentLocation := 0; 243 FLocation := 0; 244 FLineCount := 0; 245 FLineHeight := 10; 246 SetLength(FLineMap, FLineCount + 1); 247 FGutterWidth := 32; 248 FDisassemblerNotification := TIDEDisassemblerNotification.Create; 249 FDisassemblerNotification.AddReference; 250 FDisassemblerNotification.OnChange := @DisassemblerChanged; 251 BreakpointsNotification.OnAdd := @BreakPointChanged; 252 BreakpointsNotification.OnUpdate := @BreakPointChanged; 253 BreakpointsNotification.OnRemove := @BreakPointChanged; 254 FIsVScrollTrack := False; 255 FVScrollCounter := 0; 256 257 inherited Create(AOwner); 258// DoubleBuffered := True; 259 260 Caption := lisDisAssAssembler; 261 262 EditorOpts.AddHandlerAfterWrite(@DoEditorOptsChanged); 263 Caption := lisMenuViewAssembler; 264 CopyToClipboard.Caption := lisDbgAsmCopyToClipboard; 265 266 267 ToolBar1.Images := IDEImages.Images_16; 268 PopupMenu1.Images := IDEImages.Images_16; 269 270 actStepOverInstr.Caption := lisMenuStepOverInstr; 271 actStepOverInstr.Hint := lisMenuStepOverInstrHint; 272 actStepOverInstr.ImageIndex := IDEImages.LoadImage('menu_stepover_instr'); 273 274 actStepIntoInstr.Caption := lisMenuStepIntoInstr; 275 actStepIntoInstr.Hint := lisMenuStepIntoInstrHint; 276 actStepIntoInstr.ImageIndex := IDEImages.LoadImage('menu_stepinto_instr'); 277 278 actCurrentInstr.Caption := lisDisAssGotoCurrentAddress; 279 actCurrentInstr.Hint := lisDisAssGotoCurrentAddressHint; 280 actCurrentInstr.ImageIndex := IDEImages.LoadImage('debugger_current_line'); 281 282 actGotoAddr.Caption := lisDisAssGotoAddress; 283 actGotoAddr.Hint := lisDisAssGotoAddressHint; 284 actGotoAddr.ImageIndex := IDEImages.LoadImage('callstack_show'); 285 286 actCopy.Caption := lisCopy; 287 actCopy.Hint := lisCopy; 288 actCopy.ImageIndex := IDEImages.LoadImage('laz_copy'); 289 290 291 FPowerImgIdx := IDEImages.LoadImage('debugger_power'); 292 FPowerImgIdxGrey := IDEImages.LoadImage('debugger_power_grey'); 293 ToolButtonPower.ImageIndex := FPowerImgIdx; 294 295 FCurLineImgIdx := IDEImages.LoadImage('debugger_current_line'); 296 // 297 298 FImgSourceLine := IDEImages.LoadImage('debugger_source_line'); 299 FImgNoSourceLine := IDEImages.LoadImage('debugger_nosource_line'); 300end; 301 302destructor TAssemblerDlg.Destroy; 303begin 304 EditorOpts.RemoveHandlerAfterWrite(@DoEditorOptsChanged); 305 SetDisassembler(nil); 306 SetDebugger(nil); 307 FDisassemblerNotification.OnChange := nil; 308 FDisassemblerNotification.ReleaseReference; 309 inherited Destroy; 310end; 311 312procedure TAssemblerDlg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 313var 314 i: LongInt; 315begin 316 if (Shift - [ssShift] <> []) then begin 317 inherited; 318 Exit; 319 end; 320 pbAsm.Invalidate; 321 case Key of 322 VK_UP: begin 323 ToolButtonPower.Down := True; 324 ToolButtonPowerClick(nil); 325 SetSelection(FSelectLine - 1, True, ssShift in Shift); 326 Key := 0; 327 end; 328 VK_DOWN: begin 329 ToolButtonPower.Down := True; 330 ToolButtonPowerClick(nil); 331 SetSelection(FSelectLine + 1, True, ssShift in Shift); 332 Key := 0; 333 end; 334 VK_PRIOR: begin 335 ToolButtonPower.Down := True; 336 ToolButtonPowerClick(nil); 337 i := FTopLine; 338 SetSelection(FSelectLine - FLineCount, False, ssShift in Shift); 339 SetTopline(i - FLineCount); 340 Key := 0; 341 end; 342 VK_NEXT: begin 343 ToolButtonPower.Down := True; 344 ToolButtonPowerClick(nil); 345 i := FTopLine; 346 SetSelection(FSelectLine + FLineCount, False, ssShift in Shift); 347 SetTopline(i + FLineCount); 348 Key := 0; 349 end; 350 VK_LEFT: begin 351 if not EditGotoAddr.Focused then begin 352 sbHorizontal.Position := sbHorizontal.Position - sbHorizontal.SmallChange; 353 Key := 0; 354 end; 355 end; 356 VK_RIGHT: begin 357 if not EditGotoAddr.Focused then begin 358 sbHorizontal.Position := sbHorizontal.Position + sbHorizontal.SmallChange; 359 Key := 0; 360 end; 361 end; 362 VK_HOME: begin 363 if not EditGotoAddr.Focused then begin 364 sbHorizontal.Position := 0; 365 Key := 0; 366 end; 367 end; 368 else 369 inherited; 370 end; 371end; 372 373procedure TAssemblerDlg.CopyToClipboardClick(Sender: TObject); 374var 375 ALineMap: TAsmDlgLineEntries; 376 i, w: Integer; 377 s: String; 378begin 379 SetLength(ALineMap, abs(FSelectionEndLine - FSelectLine)+1); 380 UpdateLineDataEx(ALineMap, Min(FSelectionEndLine, FSelectLine), 381 abs(FSelectionEndLine - FSelectLine)+1, 382 FLastTopLine, FLastTopLineIdx, FLastTopLineIsSrc, FLastTopLineValid, False, True); 383 if FDebugger = nil 384 then W := 16 385 else W := FDebugger.TargetWidth div 4; 386 s := ''; 387 for i := 0 to length(ALineMap)-1 do 388 begin 389 s := s + FormatLine(ALineMap[i], W) + LineEnding; 390 end; 391 Clipboard.AsText := s; 392end; 393 394procedure TAssemblerDlg.EditGotoAddrChange(Sender: TObject); 395var 396 HasDisassembler: Boolean; 397begin 398 HasDisassembler := (FDebugger <> nil) and (FDisassembler <> nil); 399 actGotoAddr.Enabled := HasDisassembler and (StrToQWordDef(EditGotoAddr.Text, 0) <> 0); 400end; 401 402procedure TAssemblerDlg.EditGotoAddrKeyPress(Sender: TObject; var Key: char); 403begin 404 if (key = #13) and (StrToQWordDef(EditGotoAddr.Text, 0) <> 0) 405 then actGotoAddr.Execute; 406end; 407 408procedure TAssemblerDlg.actStepOverInstrExecute(Sender: TObject); 409var 410 Handled: Boolean; 411begin 412 Handled:=false; 413 if Assigned(OnProcessCommand) 414 then OnProcessCommand(Self, ecStepOverInstr, Handled); 415end; 416 417procedure TAssemblerDlg.BreakPointChanged(const ASender: TIDEBreakPoints; 418 const ABreakpoint: TIDEBreakPoint); 419begin 420 ClearImageIdx; 421 pbAsm.Invalidate; 422end; 423 424function TAssemblerDlg.GetBreakpointFor(AnAsmDlgLineEntry: TAsmDlgLineEntry): TIDEBreakPoint; 425begin 426 Result := nil; 427 if BreakPoints = nil then exit; 428 case AnAsmDlgLineEntry.State of 429 lmsStatement: Result := BreakPoints.Find(AnAsmDlgLineEntry.Addr); 430 lmsSource: Result := BreakPoints.Find(AnAsmDlgLineEntry.FullFileName, AnAsmDlgLineEntry.SourceLine); 431 end; 432end; 433 434procedure TAssemblerDlg.CheckImageIndexFor(var AnAsmDlgLineEntry: TAsmDlgLineEntry); 435begin 436 if BreakPoints = nil then exit; 437 if AnAsmDlgLineEntry.ImageIndex > 0 then exit; 438 if not (AnAsmDlgLineEntry.State in [lmsStatement, lmsSource]) then exit; 439 440 AnAsmDlgLineEntry.ImageIndex := GetBreakPointImageIndex(GetBreakpointFor(AnAsmDlgLineEntry), 441 (AnAsmDlgLineEntry.State = lmsStatement) and 442 (AnAsmDlgLineEntry.Addr = FLocation)); 443 if AnAsmDlgLineEntry.ImageIndex >= 0 444 then exit; 445 446 if AnAsmDlgLineEntry.State = lmsStatement 447 then AnAsmDlgLineEntry.ImageIndex := FImgNoSourceLine 448 else AnAsmDlgLineEntry.ImageIndex := FImgSourceLine; 449end; 450 451procedure TAssemblerDlg.actStepIntoInstrExecute(Sender: TObject); 452var 453 Handled: Boolean; 454begin 455 Handled:=false; 456 if Assigned(OnProcessCommand) 457 then OnProcessCommand(Self, ecStepIntoInstr, Handled); 458end; 459 460procedure TAssemblerDlg.actCurrentInstrExecute(Sender: TObject); 461begin 462 if FDisassembler.BaseAddr <> FLocation 463 then begin 464 ToolButtonPower.Down := True; 465 ToolButtonPowerClick(nil); 466 end; 467 UpdateLocation(FLocation); 468end; 469 470procedure TAssemblerDlg.actGotoAddrExecute(Sender: TObject); 471var 472 Addr: TDBGPtr; 473begin 474 ToolButtonPower.Down := True; 475 ToolButtonPowerClick(nil); 476 Addr := StrToQWordDef(EditGotoAddr.Text, 0); 477 if Addr <> 0 478 then UpdateLocation(Addr); 479end; 480 481procedure TAssemblerDlg.DisassemblerChanged(Sender: TObject); 482begin 483 if (FDisassembler = nil) or (FCurrentLocation = 0) or (FLineCount = 0) 484 then exit; 485 if (FDebugger <> nil) and (FDebugger.State <> dsPause) 486 then begin 487 // only for F9, not for F8,F7 single stepping with assembler is no good, if it clears all the time 488 //ClearLineMap; 489 FCurrentLocation := 0; 490 FLocation := 0; 491 end 492 else begin 493 UpdateView; 494 end; 495 pbAsm.Invalidate; 496end; 497 498procedure TAssemblerDlg.FormResize(Sender: TObject); 499begin 500 sbHorizontal.PageSize := pbAsm.Width; 501 sbHorizontal.LargeChange := pbAsm.Width div 3; 502 503 if FLineHeight <> 0 504 then SetLineCount(pbAsm.Height div FLineHeight); 505end; 506 507procedure TAssemblerDlg.pbAsmClick(Sender: TObject); 508var 509 P: TPoint; 510 Line: Integer; 511 b: TIDEBreakPoint; 512 Ctrl: Boolean; 513begin 514 P := pbAsm.ScreenToClient(Mouse.CursorPos); 515 debugln(['TAssemblerDlg.pbAsmClick ',dbgs(p)]); 516 if P.x > FGutterWidth then exit; 517 Line := P.Y div FLineHeight; 518 519 if not (FLineMap[Line].State in [lmsStatement, lmsSource]) 520 then exit; 521 522 b := GetBreakpointFor(FLineMap[Line]); 523 Ctrl := ssCtrl in GetKeyShiftState; 524 525 if b = nil then begin 526 DebugBoss.LockCommandProcessing; 527 try 528 if (FLineMap[Line].State = lmsStatement) 529 then DebugBoss.DoCreateBreakPoint(FLineMap[Line].Addr, True, b) 530 else DebugBoss.DoCreateBreakPoint(FLineMap[Line].FullFileName, FLineMap[Line].SourceLine, True, b); 531 if Ctrl and (b <> nil) 532 then b.Enabled := False; 533 finally 534 DebugBoss.UnLockCommandProcessing; 535 end; 536 end else begin 537 if Ctrl 538 then b.Enabled := not b.Enabled 539 else b.ReleaseReference; 540 end; 541end; 542 543procedure TAssemblerDlg.DoBeginUpdate; 544begin 545 FVisibleChanged := False; 546 inherited DoBeginUpdate; 547end; 548 549procedure TAssemblerDlg.DoEndUpdate; 550begin 551 inherited DoEndUpdate; 552 if FVisibleChanged then begin 553 DoEditorOptsChanged(nil, False); 554 if FCurrentLocation <> 0 then 555 UpdateLocation(FCurrentLocation); 556 end; 557 FVisibleChanged := False; 558end; 559 560procedure TAssemblerDlg.UpdateShowing; 561begin 562 inherited UpdateShowing; 563 if IsVisible then begin 564 if IsUpdating then begin 565 FVisibleChanged := True 566 end else begin 567 DoEditorOptsChanged(nil, False); 568 if FCurrentLocation <> 0 then 569 UpdateLocation(FCurrentLocation); 570 end; 571 end; 572end; 573 574procedure TAssemblerDlg.pbAsmMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 575begin 576 if Button <> mbLeft then exit; 577 578 SetSelection(FTopLine + Y div FLineHeight, False, ssShift in Shift); 579 FMouseIsDown := True; 580end; 581 582procedure TAssemblerDlg.pbAsmMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 583begin 584 y := Y div FLineHeight; 585 if FMouseIsDown and (y >= 0) and (y < FLineCount) 586 then SetSelection(FTopLine + Y, False, True); 587end; 588 589procedure TAssemblerDlg.pbAsmMouseUp(Sender: TObject; Button: TMouseButton; 590 Shift: TShiftState; X, Y: Integer); 591begin 592 FMouseIsDown := False; 593end; 594 595procedure TAssemblerDlg.pbAsmMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 596var 597 i, j: LongInt; 598begin 599 if not ToolButtonPower.Down then exit; 600 Handled := True; 601 602 FWheelAccu := FWheelAccu + WheelDelta; 603 j := FWheelAccu div 120; 604 if j = 0 then 605 exit; 606 607 FWheelAccu := FWheelAccu - j * 120; 608 i := FTopLine ; 609 if FSelectLine <> MaxInt 610 then SetSelection(FSelectLine - j, False, ssShift in Shift); 611 SetTopline(i - j); 612end; 613 614procedure TAssemblerDlg.pbAsmPaint(Sender: TObject); 615var 616 R: TRect; 617 n, X, Y, Line, W: Integer; 618 S: String; 619 TextStyle: TTextStyle; 620begin 621 R := pbAsm.ClientRect; 622 TextStyle := pbAsm.Canvas.TextStyle; 623 TextStyle.Wordbreak := False; 624 TextStyle.SingleLine := True; 625 pbAsm.Canvas.TextStyle := TextStyle; 626 627 pbAsm.Canvas.FillRect(R); 628 Inc(R.Left, FGutterWidth); 629 630 X := FGutterWidth - sbHorizontal.Position; 631 Y := 0; 632 Line := FTopLine; 633 634 if FDebugger = nil 635 then W := 16 636 else W := FDebugger.TargetWidth div 4; 637 638 for n := 0 to FLineCount do 639 begin 640 if Line = FSelectLine 641 then begin 642 pbAsm.Canvas.Brush.Color := clHighlight; 643 pbAsm.Canvas.Font.Color := clHighlightText; 644 pbAsm.Canvas.FillRect(R.Left, n * FLineHeight, R.Right, (n + 1) * FLineHeight); 645 if (FSelectionEndLine <> FSelectLine) 646 then begin 647 pbAsm.Canvas.Brush.Color := clHotLight; 648 pbAsm.Canvas.Brush.Style := bsClear; 649 pbAsm.Canvas.Rectangle(R.Left, n * FLineHeight, R.Right, (n + 1) * FLineHeight); 650 pbAsm.Canvas.Brush.Style := bsSolid; 651 pbAsm.Canvas.Brush.Color := clHighlight; 652 end; 653 end 654 else if (FSelectionEndLine <> FSelectLine) 655 and (line >= Min(FSelectLine, FSelectionEndLine)) 656 and (line <= Max(FSelectLine, FSelectionEndLine)) 657 then begin 658 pbAsm.Canvas.Brush.Color := clHighlight; 659 pbAsm.Canvas.Font.Color := clHighlightText; 660 pbAsm.Canvas.FillRect(R.Left, n * FLineHeight, R.Right, (n + 1) * FLineHeight); 661 end 662 else begin 663 pbAsm.Canvas.Brush.Color := pbAsm.Color; 664 pbAsm.Canvas.Font.Color := pbAsm.Font.Color; 665 end; 666 pbAsm.Canvas.Font.Bold := (FLineMap[n].State in [lmsSource, lmsFuncName]); 667 668 CheckImageIndexFor(FLineMap[n]); 669 if (FLineMap[n].ImageIndex >= 0) 670 then IDEImages.Images_16.Draw(pbAsm.Canvas, FGutterWidth - 16, Y, FLineMap[n].ImageIndex, True); 671 672 S := FormatLine(FLineMap[n], W); 673 pbAsm.Canvas.TextRect(R, X, Y, S); 674 675 Inc(Y, FLineHeight); 676 Inc(Line); 677 end; 678end; 679 680function TAssemblerDlg.FormatLine(ALine: TAsmDlgLineEntry; W: Integer) : String; 681begin 682 Result := ''; 683 //Result := Format('[a:%8.8u l:%8.8d i:%3.3u] ', [Cardinal(ALine.Addr), Line, n]); 684 Result := Result + HexStr(ALine.Addr, W) + ' '; 685 686 case ALine.State of 687 lmsUnknown: Result := Result + '??????'; 688 lmsInvalid: Result := Result + '......'; 689 lmsStatement: Result := Result + Copy(ALine.Dump + ' ', 1, 24) + ' ' + ALine.Statement; 690 lmsSource: begin 691 if ALine.SourceLine = 0 692 then Result := '---' 693 else Result := Format('%-'+IntToStr(W+25)+'s %s', 694 [Format('%s:%u %s', [ALine.FileName, ALine.SourceLine, ALine.Statement]), 695 ALine.PasCode]); 696 end; 697 lmsFuncName: Result:= ALine.FileName + ' ' + ALine.Statement; 698 end; 699end; 700 701procedure TAssemblerDlg.UpdateView; 702begin 703 if not ToolButtonPower.Down 704 then exit; 705 706 if (FDisassembler <> nil) and (FCurrentLocation <> 0) 707 then begin 708 FDisassembler.PrepareRange(FCurrentLocation, Max(0, -(FTopLine - 5)), Max(0, FTopLine + FLineCount + 1 + 5)); 709 UpdateLineData; 710 end 711 else ClearLineMap; 712 pbAsm.Invalidate; 713end; 714 715procedure TAssemblerDlg.UpdateActionEnabled; 716var 717 HasDisassembler: Boolean; 718begin 719 HasDisassembler := (FDebugger <> nil) and (FDisassembler <> nil); 720 actCurrentInstr.Enabled := HasDisassembler and (FLocation <> 0); 721 actGotoAddr.Enabled := HasDisassembler and (StrToQWordDef(EditGotoAddr.Text, 0) <> 0); 722 actCopy.Enabled := HasDisassembler; 723 actStepOverInstr.Enabled := HasDisassembler; 724 actStepIntoInstr.Enabled := HasDisassembler; 725end; 726 727procedure TAssemblerDlg.sbHorizontalChange(Sender: TObject); 728begin 729 pbAsm.Invalidate; 730end; 731 732procedure TAssemblerDlg.sbVerticalChange(Sender: TObject); 733begin 734 ToolButtonPower.Down := True; 735 ToolButtonPowerClick(nil); 736 pbAsm.Invalidate; 737 Timer1.Enabled := True; 738end; 739 740procedure TAssemblerDlg.sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); 741begin 742 FIsVScrollTrack := False; 743 case ScrollCode of 744 scLineUp: begin 745 SetTopline(FTopLine - 1); 746 end; 747 scLineDown: begin 748 SetTopline(FTopLine + 1); 749 end; 750 scPageUp: begin 751 SetTopline(FTopLine - FLineCount); 752 end; 753 scPageDown: begin 754 SetTopline(FTopLine + FLineCount); 755 end; 756 scPosition: begin 757 // doesn't work on gtk 758 end; 759 scTrack: begin 760 FVScrollPos := ScrollPos; 761 FIsVScrollTrack := True; 762 end; 763// scTop, // = SB_TOP 764// scBottom, // = SB_BOTTOM 765// scEndScroll // = SB_ENDSCROLL 766 end; 767 Timer1.Enabled := True; 768end; 769 770procedure TAssemblerDlg.Timer1Timer(Sender: TObject); 771var 772 i: Integer; 773begin 774 if (GetCaptureControl <> sbVertical) then begin 775debugln('----------------'); 776 sbVertical.Position := 475; 777 pbAsm.Invalidate; 778 FIsVScrollTrack := False; 779 Timer1.Enabled := False; 780 FVScrollCounter := 0; 781 end else 782 if FIsVScrollTrack then begin 783 i := (FVScrollPos - 475); 784 if i < 0 then dec(i, 35); 785 if i > 0 then inc(i, 35); 786 FVScrollCounter := FVScrollCounter + (i div 35); 787 if (FVScrollCounter <= -10) or (FVScrollCounter >= 10) then begin 788 i := FVScrollCounter div 10; 789 SetTopline(FTopLine + i); 790 FVScrollCounter := FVScrollCounter -(10 * i); 791 pbAsm.Invalidate; 792 end; 793 end; 794end; 795 796procedure TAssemblerDlg.ToolButtonPowerClick(Sender: TObject); 797begin 798 if ToolButtonPower.Down 799 then begin 800 ToolButtonPower.ImageIndex := FPowerImgIdx; 801 UpdateView; 802 end 803 else ToolButtonPower.ImageIndex := FPowerImgIdxGrey; 804end; 805 806procedure TAssemblerDlg.DoDebuggerDestroyed(Sender: TObject); 807begin 808 FDebugger := nil; 809 UpdateView; 810end; 811 812function TAssemblerDlg.IndexOfAddr(const AnAddr: TDBGPtr): Integer; 813begin 814 Result := length(FLineMap) - 1; 815 while Result >= 0 do begin 816 if (FLineMap[Result].State = lmsStatement) and (FLineMap[Result].Addr = AnAddr) 817 then exit; 818 dec(Result); 819 end; 820end; 821 822procedure TAssemblerDlg.UpdateLocation(const AAddr: TDBGPtr); 823var 824 i: Integer; 825begin 826 if FCurrentLocation <> AAddr 827 then begin 828 FCurrentLocation := AAddr; 829 FLastTopLineValid := False; 830 end; 831 832 i := IndexOfAddr(FCurrentLocation); 833 if (i >= 0) and (i < FLineCount - 1) 834 then begin 835 FSelectLine := FTopLine + i; 836 end 837 else begin 838 FTopLine := -(FLineCount div 2); 839 FSelectLine := 0; 840 end; 841 FSelectionEndLine := FSelectLine; 842 UpdateActionEnabled; 843 UpdateView; 844end; 845 846procedure TAssemblerDlg.DoEditorOptsChanged(Sender: TObject; Restore: boolean); 847var 848 TM: TTextMetric; 849begin 850 if Restore then exit; 851 pbAsm.Font.Size := EditorOpts.EditorFontSize; 852 pbAsm.Font.Name := EditorOpts.EditorFont; 853 if EditorOpts.DisableAntialiasing then 854 pbAsm.Font.Quality := fqNonAntialiased 855 else 856 pbAsm.Font.Quality := fqDefault; 857 858 if GetTextMetrics(pbAsm.Canvas.Handle, TM{%H-}) then 859 begin 860 FCharWidth := TM.tmMaxCharWidth; // EditorOpts.ExtraCharSpacing + 861 sbHorizontal.SmallChange := FCharWidth; 862 FLineHeight := Max(6,EditorOpts.ExtraLineSpacing + TM.tmHeight); 863 SetLineCount(pbAsm.Height div FLineHeight); 864 end; 865end; 866 867procedure TAssemblerDlg.SetLocation(ADebugger: TDebuggerIntf; const AAddr: TDBGPtr; 868 const ADispAddr: TDBGPtr); 869var 870 i: Integer; 871begin 872 SetDebugger(ADebugger); 873 874 if ADispAddr <> 0 875 then FCurrentLocation := ADispAddr 876 else FCurrentLocation := AAddr; 877 FLocation := AAddr; 878 FLastTopLineValid := False; 879 880 if not ToolButtonPower.Down 881 then begin 882 i := IndexOfAddr(FCurrentLocation); 883 if (i >= 0) 884 then FSelectLine := FTopLine + i 885 else FSelectLine := MaxInt; 886 FSelectionEndLine := FSelectLine; 887 888 pbAsm.Invalidate; 889 exit; 890 end; 891 892 FTopLine := -(FLineCount div 2); 893 FSelectLine := 0; 894 FSelectionEndLine := 0; 895 896 UpdateActionEnabled; 897 if Visible then // otherwhise in resize 898 UpdateView 899 else 900 ClearLineMap; 901end; 902 903procedure TAssemblerDlg.SetSelection(ALine: Integer; AMakeVisible: Boolean; 904 AKeepSelEnd: Boolean = False); 905var 906 OldLine: Integer; 907begin 908 if Aline = FSelectLine then Exit; 909 910 // UpdateLineData may cause eventhandling, so we enter here again 911 // set variable first 912 OldLine := FSelectLine; 913 FSelectLine := Aline; 914 915 if not AKeepSelEnd 916 then FSelectionEndLine := FSelectLine; 917 918 if AMakeVisible 919 then begin 920 if FSelectLine < OldLine 921 then begin 922 if FTopLine > FSelectLine 923 then SetTopLine(FSelectLine); 924 end 925 else begin 926 if FTopLine + FLineCount <= FSelectLine 927 then SetTopLine(FSelectLine - FLineCount + 1); 928 end; 929 end; 930 931 pbAsm.Invalidate; 932end; 933 934procedure TAssemblerDlg.SetLineCount(ALineCount: Integer); 935begin 936 if FLineCount = ALineCount 937 then exit; 938 FLineCount := ALineCount; 939 SetLength(FLineMap, FLineCount + 1); 940 UpdateView; 941end; 942 943procedure TAssemblerDlg.SetTopLine(ALine: Integer); 944var 945 PadFront, PadEnd: Integer; 946begin 947 if not ToolButtonPower.Down 948 then exit; 949 950 if FTopLine = ALine then Exit; 951 // scrolled by user, get more padding lines 952 PadFront := 5; 953 PadEnd := 5; 954 if ALine < FTopLine 955 then PadFront := 20 956 else PadEnd := 20; 957 FTopLine := ALine; 958 if (FDisassembler <> nil) 959 and ( (FDisassembler.CountBefore < Max(0, -(FTopLine - 1))) 960 or (FDisassembler.CountAfter < Max(0, FTopLine + FLineCount + 2)) ) 961 then FDisassembler.PrepareRange(FCurrentLocation, Max(0, -(FTopLine - PadFront)), Max(0, FTopLine + FLineCount + 1 + PadEnd)); 962 UpdateLineData; 963end; 964 965function TAssemblerDlg.GetSourceCodeLine(SrcFileName: string; SrcLineNumber: Integer): string; 966var 967 PasSource: TCodeBuffer; 968 Editor: TSourceEditor; 969begin 970 Result := ''; 971 if SrcLineNumber < 1 then exit; 972 if not FDebugManager.GetFullFilename(SrcFileName, False) // TODO: maybe ask user? 973 then exit; 974 PasSource := CodeToolBoss.LoadFile(SrcFileName, true, false); 975 if PasSource = nil 976 then exit; 977 978 Editor := SourceEditorManager.SourceEditorIntfWithFilename(SrcFileName); 979 if Editor <> nil then 980 SrcLineNumber := Editor.DebugToSourceLine(SrcLineNumber); 981 982 Result := Trim(PasSource.GetLine(SrcLineNumber - 1,false)); 983end; 984 985procedure TAssemblerDlg.UpdateLineData; 986begin 987 UpdateLineDataEx(FLineMap, FTopLine, FLineCount + 1, 988 FLastTopLine, FLastTopLineIdx, FLastTopLineIsSrc, FLastTopLineValid, True); 989end; 990 991procedure TAssemblerDlg.UpdateLineDataEx(ALineMap: TAsmDlgLineEntries; AFirstLine, 992 ALineCount: Integer; var ACachedLine, ACachedIdx: Integer; 993 var ACachedIsSrc, ACachedValid: Boolean; ACachedUpdate: Boolean; 994 ANoExtraHeader: Boolean = False); 995 996 function GetItem(AIdx: Integer): PDisassemblerEntry; 997 begin 998 Result := nil; 999 if (AIdx >= -FDisassembler.CountBefore) and (AIdx < FDisassembler.CountAfter) 1000 then Result := FDisassembler.EntriesPtr[AIdx]; 1001 end; 1002 1003 function IsSourceBeforeItem(AItm: PDisassemblerEntry; 1004 APrvItm: PDisassemblerEntry): Boolean; 1005 begin 1006 if AItm = nil 1007 then exit(False); 1008 1009 if AItm^.SrcFileName <> '' then begin 1010 Result := AItm^.SrcStatementIndex = 0; 1011 if (not Result) and (APrvItm <> nil) 1012 then Result := (AItm^.SrcFileName <> APrvItm^.SrcFileName) 1013 or (AItm^.SrcFileLine <> APrvItm^.SrcFileLine); 1014 end 1015 else begin 1016 Result := (AItm^.FuncName <> ''); 1017 if Result 1018 then Result := (AItm^.Offset = 0) 1019 or ( (APrvItm <> nil) and (AItm^.FuncName <> APrvItm^.FuncName) ); 1020 end; 1021 end; 1022 1023var 1024 DoneLocation: TDBGPtr; 1025 DoneTopLine, DoneLineCount: Integer; 1026 DoneCountBefore, DoneCountAfter: Integer; 1027 Line, Idx: Integer; 1028 Itm, NextItm, PrevItm: PDisassemblerEntry; 1029 LineIsSrc, HasLineOutOfRange: Boolean; 1030 s: String; 1031begin 1032 if (FDebugger = nil) or (FDisassembler = nil) or (FDebugger.State <> dsPause) 1033 then begin 1034 ClearLineMap; // set all to lmsUnknown; 1035 exit; 1036 end; 1037 if FDisassembler.BaseAddr <> FCurrentLocation 1038 then begin 1039 ClearLineMap(lmsInvalid); 1040 exit; 1041 end; 1042 1043 if FUpdating 1044 then begin 1045 FUpdateNeeded := True; 1046 Exit; 1047 end; 1048 FUpdating := True; 1049 1050 try 1051 FUpdateNeeded := False; 1052 DoneLocation := FCurrentLocation; 1053 DoneTopLine := AFirstLine; 1054 DoneLineCount := ALineCount; 1055 DoneCountBefore := FDisassembler.CountBefore; 1056 DoneCountAfter := FDisassembler.CountAfter; 1057 1058 // Find Idx for topline 1059 Line := 0; 1060 Idx := 0; 1061 LineIsSrc := False; 1062 if ACachedValid 1063 and (abs(AFirstLine - ACachedLine) < AFirstLine) 1064 then begin 1065 Line := ACachedLine; 1066 Idx := ACachedIdx; 1067 LineIsSrc := ACachedIsSrc; 1068 end; 1069 1070 Itm := GetItem(Idx); 1071 NextItm := GetItem(Idx + 1); 1072 1073 while AFirstLine > Line 1074 do begin 1075 NextItm := GetItem(Idx+1); 1076 if LineIsSrc 1077 then begin 1078 LineIsSrc := False; 1079 end 1080 else if IsSourceBeforeItem(NextItm, Itm) 1081 then begin 1082 inc(Idx); 1083 Itm := NextItm; 1084 NextItm := GetItem(Idx + 1); 1085 LineIsSrc := True; 1086 end 1087 else begin 1088 inc(Idx); 1089 Itm := NextItm; 1090 NextItm := GetItem(Idx + 1); 1091 end; 1092 inc(Line); 1093 end; 1094 1095 Itm := GetItem(Idx); 1096 PrevItm := GetItem(Idx - 1); 1097 while AFirstLine < line 1098 do begin 1099 if LineIsSrc 1100 then begin 1101 dec(Idx); 1102 Itm := PrevItm; 1103 PrevItm := GetItem(Idx - 1); 1104 LineIsSrc := False; 1105 end 1106 else if IsSourceBeforeItem(Itm, PrevItm) 1107 then begin 1108 LineIsSrc := True; 1109 end 1110 else begin 1111 dec(Idx); 1112 Itm := PrevItm; 1113 PrevItm := GetItem(Idx - 1); 1114 end; 1115 Dec(Line); 1116 end; 1117 1118 if ACachedUpdate 1119 then begin 1120 ACachedLine := AFirstLine; 1121 ACachedIdx := Idx; 1122 ACachedIsSrc := LineIsSrc; 1123 ACachedValid := True; 1124 end; 1125 1126 // Fill LineMap 1127 HasLineOutOfRange := False; 1128 Line := 0; 1129 PrevItm := GetItem(Idx - 1); 1130 NextItm := GetItem(Idx); 1131 while Line < ALineCount do begin 1132 PrevItm := Itm; 1133 Itm := NextItm; 1134 NextItm := GetItem(Idx+1); 1135 ALineMap[Line].ImageIndex := -1; 1136 ALineMap[Line].Offset := 0; 1137 1138 if Itm = nil 1139 then begin 1140 ALineMap[Line].State := lmsInvalid; 1141 HasLineOutOfRange := True; 1142 inc(Line); 1143 inc(idx); 1144 continue; 1145 end; 1146 1147 if ( (Line = 0) and LineIsSrc ) 1148 or ( (Line <> 0) and IsSourceBeforeItem(Itm, PrevItm) ) 1149 then begin 1150 ALineMap[Line].Dump := ''; 1151 ALineMap[Line].Statement := ''; 1152 if Itm^.SrcFileName <> '' 1153 then begin 1154 s := Itm^.SrcFileName; 1155 if not FDebugManager.GetFullFilename(s, False) 1156 then s := Itm^.SrcFileName; 1157 ALineMap[Line].State := lmsSource; 1158 ALineMap[Line].SourceLine := Itm^.SrcFileLine; 1159 ALineMap[Line].FileName := Itm^.SrcFileName; 1160 ALineMap[Line].FullFileName := s; 1161 ALineMap[Line].PasCode := GetSourceCodeLine(Itm^.SrcFileName, Itm^.SrcFileLine); 1162 end 1163 else begin 1164 ALineMap[Line].State := lmsFuncName; 1165 ALineMap[Line].SourceLine := Itm^.Offset; 1166 ALineMap[Line].FileName := Itm^.FuncName; 1167 end; 1168 inc(Line); 1169 end 1170 else 1171 if (Line = 0) and (not ANoExtraHeader) // but it's not LineIsSrc 1172 and ( ( (Itm^.SrcFileName <> '') and (Itm^.SrcStatementIndex <> Itm^.SrcStatementCount-1) ) 1173 or ( (Itm^.SrcFileName = '') and (Itm^.FuncName <> '') and (NextItm <> nil) and (Itm^.Offset < NextItm^.Offset) ) 1174 ) 1175 then begin 1176 ALineMap[Line].Dump := ''; 1177 ALineMap[Line].Statement := ''; 1178 if Itm^.SrcFileName <> '' 1179 then begin 1180 s := Itm^.SrcFileName; 1181 if not FDebugManager.GetFullFilename(s, False) 1182 then s := Itm^.SrcFileName; 1183 ALineMap[Line].State := lmsSource; 1184 ALineMap[Line].SourceLine := Itm^.SrcFileLine; 1185 ALineMap[Line].FileName := Itm^.SrcFileName; 1186 ALineMap[Line].FullFileName := s; 1187 if NextItm <> nil 1188 then ALineMap[Line].Statement := Format('(%d of %d)', [NextItm^.SrcStatementIndex, NextItm^.SrcStatementCount]) 1189 else ALineMap[Line].Statement := Format('(??? of %d)', [Itm^.SrcStatementCount]); 1190 ALineMap[Line].PasCode := GetSourceCodeLine(Itm^.SrcFileName, Itm^.SrcFileLine); 1191 end 1192 else begin 1193 ALineMap[Line].State := lmsFuncName; 1194 ALineMap[Line].SourceLine := 0; 1195 if NextItm <> nil 1196 then ALineMap[Line].SourceLine := NextItm^.Offset; 1197 ALineMap[Line].FileName := Itm^.FuncName; 1198 if NextItm <> nil 1199 then ALineMap[Line].Statement := Format('(%d)', [NextItm^.Offset]) 1200 else ALineMap[Line].Statement := '(???)'; 1201 end; 1202 inc(Line); 1203 inc(idx); // displayed source-info, instead of asm (topline substituted) 1204 LineIsSrc := False; 1205 continue; 1206 end; 1207 LineIsSrc := False; // only for topline 1208 1209 if Line >= ALineCount 1210 then break; 1211 1212 ALineMap[Line].Addr := Itm^.Addr; 1213 ALineMap[Line].Offset := Itm^.Offset; 1214 ALineMap[Line].State := lmsStatement; 1215 ALineMap[Line].Dump := Itm^.Dump; 1216 ALineMap[Line].Statement := Itm^.Statement; 1217 ALineMap[Line].SourceLine := Itm^.SrcFileLine; 1218 ALineMap[Line].ImageIndex := -1; 1219 1220 inc(Line); 1221 inc(idx); 1222 end; 1223 1224 finally 1225 FUpdating := False; 1226 if FUpdateNeeded 1227 and ( (DoneLocation <> FCurrentLocation) 1228 or (DoneTopLine <> AFirstLine) 1229 or (DoneLineCount <> ALineCount) 1230 or (HasLineOutOfRange 1231 and ( (DoneCountBefore <> FDisassembler.CountBefore) 1232 or (DoneCountAfter <> FDisassembler.CountAfter) ) ) 1233 ) 1234 then UpdateLineData; 1235 end; 1236end; 1237 1238initialization 1239 1240 AsmWindowCreator := IDEWindowCreators.Add(DebugDialogNames[ddtAssembler]); 1241 AsmWindowCreator.OnCreateFormProc := @CreateDebugDialog; 1242 AsmWindowCreator.CreateSimpleLayout; 1243 1244end. 1245 1246