From df49c8ebd2477cc169ef719e5da3321063043a39 Mon Sep 17 00:00:00 2001
From: marc <marc@lazarus-ide.org>
Date: Tue, 9 Dec 2008 09:40:24 +0000
Subject: [PATCH] + add forgotten dialogs

git-svn-id: trunk@17750 -
---
 .gitattributes            |   3 +
 debugger/assemblerdlg.lfm |  46 ++++
 debugger/assemblerdlg.lrs |  18 ++
 debugger/assemblerdlg.pp  | 475 ++++++++++++++++++++++++++++++++++++++
 4 files changed, 542 insertions(+)
 create mode 100644 debugger/assemblerdlg.lfm
 create mode 100644 debugger/assemblerdlg.lrs
 create mode 100644 debugger/assemblerdlg.pp

diff --git a/.gitattributes b/.gitattributes
index bbd8835e15..88297d6486 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -1582,6 +1582,9 @@ debian/patches/01_topmakefile.dpatch svneol=native#text/plain
 debian/patches/02_components.dpatch svneol=native#text/plain
 debian/rules svneol=native#text/plain
 debian/watch svneol=native#text/plain
+debugger/assemblerdlg.lfm svneol=native#text/pascal
+debugger/assemblerdlg.lrs svneol=native#text/pascal
+debugger/assemblerdlg.pp svneol=native#text/pascal
 debugger/breakpointsdlg.lfm svneol=native#text/plain
 debugger/breakpointsdlg.lrs svneol=native#text/pascal
 debugger/breakpointsdlg.pp svneol=native#text/pascal
diff --git a/debugger/assemblerdlg.lfm b/debugger/assemblerdlg.lfm
new file mode 100644
index 0000000000..f69b00b11c
--- /dev/null
+++ b/debugger/assemblerdlg.lfm
@@ -0,0 +1,46 @@
+inherited AssemblerDlg: TAssemblerDlg
+  Left = 488
+  Height = 301
+  Top = 143
+  Width = 400
+  HorzScrollBar.Page = 399
+  HorzScrollBar.Range = 399
+  VertScrollBar.Page = 300
+  VertScrollBar.Range = 300
+  AutoScroll = False
+  Caption = 'Assembler'
+  ClientHeight = 301
+  ClientWidth = 400
+  KeyPreview = True
+  OnKeyDown = FormKeyDown
+  OnResize = FormResize
+  object pbAsm: TPaintBox[0]
+    Height = 272
+    Width = 376
+    OnMouseDown = pbAsmMouseDown
+    OnMouseWheel = pbAsmMouseWheel
+    OnPaint = pbAsmPaint
+  end
+  object sbHorizontal: TScrollBar[1]
+    Height = 15
+    Top = 285
+    Width = 384
+    Max = 1000
+    PageSize = 200
+    TabOrder = 0
+    OnChange = sbHorizontalChange
+  end
+  object sbVertical: TScrollBar[2]
+    Left = 384
+    Height = 280
+    Width = 15
+    Kind = sbVertical
+    LargeChange = 10
+    Max = 1000
+    PageSize = 50
+    Position = 475
+    TabOrder = 1
+    OnChange = sbVerticalChange
+    OnScroll = sbVerticalScroll
+  end
+end
diff --git a/debugger/assemblerdlg.lrs b/debugger/assemblerdlg.lrs
new file mode 100644
index 0000000000..d5938cde62
--- /dev/null
+++ b/debugger/assemblerdlg.lrs
@@ -0,0 +1,18 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TAssemblerDlg','FORMDATA',[
+  'TPF0'#241#13'TAssemblerDlg'#12'AssemblerDlg'#4'Left'#3#232#1#6'Height'#3'-'#1
+  +#3'Top'#3#143#0#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#19'HorzScrol'
+  +'lBar.Range'#3#143#1#18'VertScrollBar.Page'#3','#1#19'VertScrollBar.Range'#3
+  +','#1#10'AutoScroll'#8#7'Caption'#6#9'Assembler'#12'ClientHeight'#3'-'#1#11
+  +'ClientWidth'#3#144#1#10'KeyPreview'#9#9'OnKeyDown'#7#11'FormKeyDown'#8'OnRe'
+  +'size'#7#10'FormResize'#0#242#2#0#9'TPaintBox'#5'pbAsm'#6'Height'#3#16#1#5'W'
+  +'idth'#3'x'#1#11'OnMouseDown'#7#14'pbAsmMouseDown'#12'OnMouseWheel'#7#15'pbA'
+  +'smMouseWheel'#7'OnPaint'#7#10'pbAsmPaint'#0#0#242#2#1#10'TScrollBar'#12'sbH'
+  +'orizontal'#6'Height'#2#15#3'Top'#3#29#1#5'Width'#3#128#1#3'Max'#3#232#3#8'P'
+  +'ageSize'#3#200#0#8'TabOrder'#2#0#8'OnChange'#7#18'sbHorizontalChange'#0#0
+  +#242#2#2#10'TScrollBar'#10'sbVertical'#4'Left'#3#128#1#6'Height'#3#24#1#5'Wi'
+  +'dth'#2#15#4'Kind'#7#10'sbVertical'#11'LargeChange'#2#10#3'Max'#3#232#3#8'Pa'
+  +'geSize'#2'2'#8'Position'#3#219#1#8'TabOrder'#2#1#8'OnChange'#7#16'sbVertica'
+  +'lChange'#8'OnScroll'#7#16'sbVerticalScroll'#0#0#0
+]);
diff --git a/debugger/assemblerdlg.pp b/debugger/assemblerdlg.pp
new file mode 100644
index 0000000000..2b293b9ce5
--- /dev/null
+++ b/debugger/assemblerdlg.pp
@@ -0,0 +1,475 @@
+unit AssemblerDlg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  ComCtrls, StdCtrls, Grids, ExtCtrls, LclType, DebuggerDlg, Debugger,
+  EditorOptions, Maps, Math;
+
+type
+
+  { TAssemblerDlg }
+
+  TAsmDlgLineMapState = (
+    lmsUnknown,
+    lmsInvalid,    // debugger couldn't disassemble this address
+    lmsStatement,  // display line as assembler
+    lmsSource      // display line as source
+  );
+
+  TAssemblerDlg = class(TDebuggerDlg)
+    pbAsm: TPaintBox;
+    sbHorizontal: TScrollBar;
+    sbVertical: TScrollBar;
+    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure FormResize(Sender: TObject);
+    procedure pbAsmMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+    procedure pbAsmMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
+    procedure pbAsmPaint(Sender: TObject);
+    procedure sbHorizontalChange(Sender: TObject);
+    procedure sbVerticalChange(Sender: TObject);
+    procedure sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
+  private
+    FDebugger: TDebugger;
+    FTopLine: Integer;
+    FSelectLine: Integer;
+    FLineCount: Integer;
+    FLineHeight: Integer;
+    FLineMap: array[Byte] of record // cyclic buffer
+      State: TAsmDlgLineMapState;
+      Line: Integer;
+      Addr: TDbgPtr;
+      Dump: String;
+      Statement: String;
+    end;
+    FLineMapMin: Byte;
+    FLineMapMax: Byte;
+    FLineMapValid: Boolean;
+    FCharWidth: Integer;
+    FGutterWidth: Integer;
+    FUpdating: Boolean;
+    FUpdateNeeded: Boolean;
+    procedure ClearLineMap;
+    procedure UpdateLineData(ALine: Integer);
+    procedure SetSelection(ALine: Integer; AMakeVisible: Boolean);
+    procedure SetTopLine(ALine: Integer);
+  protected
+    procedure InitializeWnd; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    procedure SetLocation(ADebugger: TDebugger; const AAddr: TDBGPtr);
+  end;
+
+implementation
+
+{ TAssemblerDlg }
+
+procedure TAssemblerDlg.ClearLineMap;
+var
+  n: Integer;
+begin
+  FLineMapMin := 0;
+  FLineMapMax := 0;
+  FLineMapValid := False;
+  for n := Low(FLineMap) to High(FLineMap) do
+  begin
+    FLineMap[n].Line := n;
+    FLineMap[n].State := lmsUnknown;
+  end;
+end;
+
+constructor TAssemblerDlg.Create(AOwner: TComponent);
+begin
+  FLineHeight := Abs(EditorOpts.EditorFontHeight) + EditorOpts.ExtraLineSpacing;
+  FGutterWidth := 32;
+
+  inherited Create(AOwner);
+//  DoubleBuffered := True;
+
+  pbAsm.Font.Name := EditorOpts.EditorFont;
+  pbAsm.Font.Height := EditorOpts.EditorFontHeight;
+end;
+
+destructor TAssemblerDlg.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TAssemblerDlg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+  if Shift <> [] then Exit;
+  case Key of
+    VK_UP:   begin
+      SetSelection(FSelectLine - 1, True);
+      Exit;
+    end;
+    VK_DOWN: begin
+      SetSelection(FSelectLine + 1, True);
+      Exit;
+    end;
+    VK_PRIOR: begin
+      Dec(FSelectLine, FLineCount);
+      SetTopline(FTopLine - FLineCount);
+    end;
+    VK_NEXT: begin
+      Inc(FSelectLine, FLineCount);
+      SetTopline(FTopLine + FLineCount);
+    end;
+    VK_LEFT: sbHorizontal.Position := sbHorizontal.Position - sbHorizontal.SmallChange;
+    VK_RIGHT: sbHorizontal.Position := sbHorizontal.Position + sbHorizontal.SmallChange;
+    VK_HOME: sbHorizontal.Position := 0;
+  end;
+  pbAsm.Invalidate;
+end;
+
+procedure TAssemblerDlg.FormResize(Sender: TObject);
+var
+  R: TRect;
+  n: Integer;
+begin
+  R := ClientRect;
+  Dec(R.Right, sbVertical.Width);
+  Dec(R.Bottom, sbHorizontal.Height);
+  sbVertical.Left := R.Right;
+  sbVertical.Height := R.Bottom;
+
+  sbHorizontal.Top := R.Bottom;
+  sbHorizontal.Width := R.Right;
+  sbHorizontal.PageSize := R.Right;
+  sbHorizontal.LargeChange := R.Right div 3;
+
+  FLineCount := R.Bottom div FLineHeight;
+  UpdateLineData(FTopLine + FLineCount);
+
+  pbAsm.SetBounds(0, 0, R.Right, R.Bottom);
+end;
+
+procedure TAssemblerDlg.InitializeWnd;
+begin
+  inherited InitializeWnd;
+
+  FCharWidth := EditorOpts.ExtraCharSpacing + pbAsm.Canvas.TextExtent('X').cx;
+  sbHorizontal.SmallChange := FCHarWidth;
+end;
+
+procedure TAssemblerDlg.pbAsmMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  if Button <> mbLeft then exit;
+
+  SetSelection(FTopLine + Y div FLineHeight, True);
+end;
+
+procedure TAssemblerDlg.pbAsmMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
+begin
+  Handled := True;
+
+  SetSelection(FSelectLine - (WheelDelta div 120), True);
+end;
+
+procedure TAssemblerDlg.pbAsmPaint(Sender: TObject);
+var
+  R: TRect;
+  n, X, Y, Line, idx: Integer;
+  S: String;
+  Addr: TDbgPtr;
+  State: TAsmDlgLineMapState;
+begin
+
+  R := pbAsm.ClientRect;
+//  pbAsm.Canvas.Brush.Color := clWindow;
+  pbAsm.Canvas.FillRect(R);
+
+  Inc(R.Left, FGutterWidth);
+
+  X := FGutterWidth - sbHorizontal.Position;
+  Y := 0;
+  Line := FTopLine;
+  idx := Cardinal(Line) mod Length(FLineMap);
+
+  for n := 0 to FLineCount do
+  begin
+    if Line = FSelectLine
+    then begin
+      pbAsm.Canvas.Brush.Color := clHighlight;
+      pbAsm.Canvas.Font.Color := clHighlightText;
+      pbAsm.Canvas.FillRect(R.Left, n * FLineHeight, R.Right, (n + 1) * FLineHeight);
+    end
+    else begin
+      pbAsm.Canvas.Brush.Color := pbAsm.Color;
+      pbAsm.Canvas.Font.Color := pbAsm.Font.Color;
+    end;
+
+    S := '';
+    //S :=  Format('[a:%8.8u l:%8.8d i:%3.3u] ', [Cardinal(FLineMap[idx].Addr), Line, idx]);
+    if FDebugger <> nil
+    then S := S + HexStr(FLineMap[idx].Addr, FDebugger.TargetWidth div 4) + ' ';
+    if FLineMap[idx].Line = Line
+    then begin
+      case FLineMap[idx].State of
+        lmsUnknown: S := S + '??????';
+        lmsInvalid: S := S + '......';
+        lmsStatement: S := S + Copy(FLineMap[idx].Dump + '                 ', 1, 17) + FLineMap[idx].Statement;
+      end;
+    end;
+    pbAsm.Canvas.TextRect(R, X, Y, S);
+    Inc(Y, FLineHeight);
+    Inc(Line);
+    if idx < High(FLineMap)
+    then Inc(Idx)
+    else Idx := 0;
+  end;
+end;
+
+procedure TAssemblerDlg.sbHorizontalChange(Sender: TObject);
+begin
+  pbAsm.Invalidate;
+end;
+
+procedure TAssemblerDlg.sbVerticalChange(Sender: TObject);
+begin
+  sbVertical.Position := 475;
+  pbAsm.Invalidate;
+end;
+
+procedure TAssemblerDlg.sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
+begin
+  case ScrollCode of
+    scLineUp: begin
+      SetTopline(FTopLine - 1);
+    end;
+    scLineDown: begin
+      SetTopline(FTopLine + 1);
+    end;
+    scPageUp: begin
+      SetTopline(FTopLine - FLineCount);
+    end;
+    scPageDown: begin
+      SetTopline(FTopLine + FLineCount);
+    end;
+    scPosition: begin
+      // doesn't work on gtk
+    end;
+    scTrack: begin
+      // --- remove when scPosition works
+      ScrollPos := 475;
+      Exit;
+      // ---
+
+      if ScrollPos = 475 then Exit;
+      if ScrollPos < 475
+      then SetTopline(FTopLine - 1)
+      else SetTopline(FTopLine + 1);
+    end;
+//    scTop,      // = SB_TOP
+//    scBottom,   // = SB_BOTTOM
+//    scEndScroll // = SB_ENDSCROLL
+  end;
+end;
+
+procedure TAssemblerDlg.SetLocation(ADebugger: TDebugger; const AAddr: TDBGPtr);
+begin
+  FDebugger := ADebugger;
+  ClearLineMap;
+  FLineMapMin := 0;
+  FLineMapMax := 0;
+  FLineMap[0].Addr := AAddr;
+  FLineMap[0].Line := 0;
+  FLineMapValid := True;
+  FTopLine := 0;
+  FSelectLine := FTopLine;
+  UpdateLineData(0); // start
+  UpdateLineData(FLineCount); // rest
+
+  pbAsm.Invalidate;
+end;
+
+procedure TAssemblerDlg.SetSelection(ALine: Integer; AMakeVisible: Boolean);
+var
+  OldLine: Integer;
+begin
+  if Aline = FSelectLine then Exit;
+
+  // UpdateLineData may cause eventhandling, so we enter here again
+  // set variable first
+  OldLine := FSelectLine;
+  FSelectLine := Aline;
+
+  if AMakeVisible
+  then begin
+    if FSelectLine < OldLine
+    then begin
+      if FTopLine > FSelectLine
+      then SetTopLine(FSelectLine);
+    end
+    else begin
+      if FTopLine + FLineCount <= FSelectLine
+      then SetTopLine(FSelectLine - FLineCount + 1);
+    end;
+  end;
+
+  pbAsm.Invalidate;
+end;
+
+procedure TAssemblerDlg.SetTopLine(ALine: Integer);
+var
+  OldTop: Integer;
+begin
+  if FTopLine = ALine then Exit;
+
+  if not FLineMapValid
+  then begin
+    FTopLine := ALine;
+    pbAsm.Invalidate;
+    Exit;
+  end;
+
+  // UpdateLineData may cause eventhandling, so we enter here again
+  // set variable first
+  OldTop := FTopLine;
+  FTopLine := ALine;
+
+  if FTopLine < OldTop
+  then begin
+    // before
+    UpdateLineData(FTopLine);
+  end
+  else begin
+    // after
+    UpdateLineData(FTopLine + FLineCount);
+  end;
+
+  pbAsm.Invalidate;
+end;
+
+
+procedure TAssemblerDlg.UpdateLineData(ALine: Integer);
+var
+  Addr, NextAddr: TDbgPtr;
+  OK: Boolean;
+  Line: Integer;
+  Idx: Byte;
+  Dump, Statement: String;
+begin
+  if FDebugger = nil then Exit;
+  if not FLineMapValid then Exit;
+
+  // while accessing external debugger, events are handled, so we could enter here again
+  if FUpdating
+  then begin
+    FUpdateNeeded := True;
+    Exit;
+  end;
+  FUpdating := True;
+  try
+    while FLineMap[FLineMapMin].Line > ALine do
+    begin
+      // get lines before min
+      Addr := FLineMap[FLineMapMin].Addr;
+      Line := FLineMap[FLineMapMin].Line - 1;
+      if FLineMapMin = 0
+      then FLineMapMin := High(FLineMap)
+      else Dec(FLineMapMin);
+      // check if we overlap with our end
+      if FLineMapMin = FLineMapMax
+      then begin
+        if FLineMapMax = 0
+        then FLineMapMax := High(FLineMap)
+        else Dec(FLineMapMax);
+      end;
+
+      FLineMap[FLineMapMin].State := lmsUnknown;
+      FLineMap[FLineMapMin].Line := Line;
+      OK := FDebugger.Disassemble(Addr, True, NextAddr, Dump, Statement);
+      if OK
+      then begin
+        FLineMap[FLineMapMin].State := lmsStatement;
+        FLineMap[FLineMapMin].Dump := Dump;
+        FLineMap[FLineMapMin].Statement := Statement;
+      end
+      else begin
+        FLineMap[FLineMapMin].State := lmsInvalid;
+        NextAddr := Addr - 1;
+      end;
+      FLineMap[FLineMapMin].Addr := NextAddr;
+      if OK and (Line = ALine) then Exit;
+    end;
+
+    if FLineMap[FLineMapMax].Line < ALine
+    then begin
+      // get lines after max
+      // get startingpoint
+      Addr := FLineMap[FLineMapMax].Addr;
+      if not FDebugger.Disassemble(Addr, False, NextAddr, Dump, Statement)
+      then NextAddr := Addr + 1;
+
+      while FLineMap[FLineMapMax].Line < ALine do
+      begin
+        Addr := NextAddr;
+        Line := FLineMap[FLineMapMax].Line + 1;
+        if FLineMapMax = High(FLineMap)
+        then FLineMapMax := 0
+        else Inc(FLineMapMax);
+        // check if we overlap with our start
+        if FLineMapMin = FLineMapMax
+        then begin
+          if FLineMapMin = High(FLineMap)
+          then FLineMapMin := 0
+          else Inc(FLineMapMin);
+        end;
+
+        FLineMap[FLineMapMax].State := lmsUnknown;
+        FLineMap[FLineMapMax].Line := Line;
+        FLineMap[FLineMapMax].Addr := Addr;
+        OK := FDebugger.Disassemble(Addr, False, NextAddr, Dump, Statement);
+        if OK
+        then begin
+          FLineMap[FLineMapMax].State := lmsStatement;
+          FLineMap[FLineMapMax].Dump := Dump;
+          FLineMap[FLineMapMax].Statement := Statement;
+        end
+        else begin
+          FLineMap[FLineMapMax].State := lmsInvalid;
+          NextAddr := Addr + 1;
+        end;
+        if OK and (Line = ALine) then Exit;
+      end;
+    end;
+
+    idx := Cardinal(ALine) mod Length(FLineMap);
+    if FLineMap[idx].State <> lmsUnknown then Exit;
+
+    FLineMap[idx].Line := ALine;
+    Addr := FLineMap[idx].Addr;
+    if FDebugger.Disassemble(Addr, False, NextAddr, Dump, Statement)
+    then begin
+      FLineMap[idx].State := lmsStatement;
+      FLineMap[idx].Dump := Dump;
+      FLineMap[idx].Statement := Statement;
+    end
+    else begin
+      FLineMap[idx].State := lmsUnknown;
+    end;
+  finally
+    FUpdating := False;
+    if FUpdateNeeded
+    then begin
+      FUpdateNeeded := False;
+      // check begin and end
+      UpdateLineData(FTopLine);
+      UpdateLineData(FTopLine + FLineCount);
+    end;
+  end;
+end;
+
+
+
+initialization
+  {$I assemblerdlg.lrs}
+
+end.
+