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