observercsource.pas

一个不出名的GBA模拟器

//////////////////////////////////////////////////////////////////////
//                                                                  //
// observerCSource.pas: Source level debugger                       //
//                                                                  //
// The contents of this file are subject to the Bottled Light       //
// Public License Version 1.0 (the "License"); you may not use this //
// file except in compliance with the License. You may obtain a     //
// copy of the License at http://www.bottledlight.com/BLPL/         //
//                                                                  //
// Software distributed under the License is distributed on an      //
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or   //
// implied. See the License for the specific language governing     //
// rights and limitations under the License.                        //
//                                                                  //
// The Original Code is the Mappy VM User Interface, released       //
// April 1st, 2003. The Initial Developer of the Original Code is   //
// Bottled Light, Inc. Portions created by Bottled Light, Inc. are  //
// Copyright (C) 2001-2003 Bottled Light, Inc. All Rights Reserved. //
//                                                                  //
// Author(s):                                                       //
//   Michael Noland (joat), [e-mail]                //
//                                                                  //
// Changelog:                                                       //
//   1.0: First public release (April 1st, 2003)                    //
//                                                                  //
// Notes:                                                           //
//   IN PROGRESS, NEEDS WORK                                        //
//                                                                  //
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
unit observerCSource; ////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
interface ////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Menus, SynEditHighlighter, SynHighlighterCpp,
  SynEdit, SynMemo, cpuObservers, console, dwarfUtils, ImgList,
  nexus, ExtCtrls, ToolWin, AddressSpace, StdCtrls, Math;

//////////////////////////////////////////////////////////////////////

type
  TDebuggerLineInfo = (dlCurrentLine, dlBreakpointLine, dlExecutableLine);

  TDebuggerLineInfos = set of TDebuggerLineInfo;

  TjdevSourceViewer = class(TCpuObserver)
    cSyntaxHighlighter: TSynCppSyn;
    status: TStatusBar;
    openDialog: TOpenDialog;
    imglActions: TImageList;
    imglGutterGlyphs: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    contextMenu: TPopupMenu;
    mToggleBreakpoint: TMenuItem;
    N1: TMenuItem;
    mChangeFont: TMenuItem;
    fontDialog: TFontDialog;
    mainMenu: TMainMenu;
    topHorizSplitter: TSplitter;
    editorHolder: TPanel;
    tabs: TTabControl;
    classviewHolder: TPanel;
    classFileToggle: TPageControl;
    tsClassView: TTabSheet;
    tsFileView: TTabSheet;
    fileView: TTreeView;
    bottomHolder: TPanel;
    verticalSplitter: TSplitter;
    memo: TSynMemo;
    logHolder: TPanel;
    log: TListBox;
    variableHolder: TPanel;
    variableViewTabs: TTabControl;
    variableView: TListView;
    bottomHorizSplitter: TSplitter;
    Run1: TMenuItem;
    mStepOver: TMenuItem;
    mTraceInto: TMenuItem;
    mTraceToNextSourceLine: TMenuItem;
    mRunToCursor: TMenuItem;
    mStepOut: TMenuItem;
    N2: TMenuItem;
    mShowExecutionPoint: TMenuItem;
    mInspect: TMenuItem;
    N3: TMenuItem;
    classView: TTreeView;
    treeIcons: TImageList;
    procedure memoStatusChange(Sender: TObject; Changes: TSynStatusChanges);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tabsChanging(Sender: TObject; var AllowChange: Boolean);
    procedure tabsChange(Sender: TObject);
    procedure goToLineNumber(Sender: TObject);
    procedure FindPC1Click(Sender: TObject);
    procedure memoGutterClick(Sender: TObject; X, Y, Line: Integer; mark: TSynEditMark);
    procedure memoSpecialLineColors(Sender: TObject; Line: Integer; var Special: Boolean; var FG, BG: TColor);
    procedure mStepClick(Sender: TObject);
    procedure mToggleBreakpointClick(Sender: TObject);
    procedure ChangeFont(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure fileViewGetImageIndex(Sender: TObject; Node: TTreeNode);
    procedure fileViewClick(Sender: TObject);
    procedure classViewClick(Sender: TObject);
  private
    { Private declarations }
    targetFile: string;

    currentUnit: TCompilationUnit;
    amUpdating: boolean;
    fourNodes: array[0..3] of TTreeNode;
    threeNodes: array[0..2] of TTreeNode;
    procedure PaintGutterGlyphs(ACanvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer);
  public
    procedure UpdateObserver; override;
    class function OCaption: string; override;
    function addTab(filename: string): integer;
    procedure focusFileTab(index: integer);
    procedure SetupFileView;
    procedure AddToFileView(filename: string; tab: integer);
    procedure BuildClassView;

    procedure UpdateLog;

    procedure WalkCVNode(node: PDwarfNode; dnode: TTreeNode);
    procedure AttributeCV(node: PDwarfNode; var dnode: TTreeNode);
  end;

//////////////////////////////////////////////////////////////////////

  TDebugSupportPlugin = class(TSynEditPlugin)
  protected
    FForm: TjdevSourceViewer;
    procedure AfterPaint(ACanvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer); override;
    procedure LinesInserted(FirstLine, Count: integer); override;
    procedure LinesDeleted(FirstLine, Count: integer); override;
  public
    constructor Create(AForm: TjdevSourceViewer);
  end;

//////////////////////////////////////////////////////////////////////

//function focusSourceFile(filename: string; train: boolean): TStringList;
function loadSourceFile(filename: string): TStringList;
function focusFile(filename: string): TStringList;
function findFile(filename: string): TStringList;
procedure closeSourceFiles;

//////////////////////////////////////////////////////////////////////

var
  jdevSourceViewer: TjdevSourceViewer;
  fileList: TStringList;

//////////////////////////////////////////////////////////////////////
implementation ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

{$R *.DFM}

//////////////////////////////////////////////////////////////////////
// TGutterMarkDrawPlugin /////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

constructor TDebugSupportPlugin.Create(AForm: TjdevSourceViewer);
begin
  inherited Create(AForm.memo);
  FForm := AForm;
end;

//////////////////////////////////////////////////////////////////////

procedure TDebugSupportPlugin.AfterPaint(ACanvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer);
begin
  FForm.PaintGutterGlyphs(ACanvas, AClip, FirstLine, LastLine);
end;

//////////////////////////////////////////////////////////////////////

procedure TDebugSupportPlugin.LinesDeleted(FirstLine, Count: integer);
begin
end;

//////////////////////////////////////////////////////////////////////

procedure TDebugSupportPlugin.LinesInserted(FirstLine, Count: integer);
begin
end;

//////////////////////////////////////////////////////////////////////
// TjdevSourceViewer /////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

class function TjdevSourceViewer.OCaption: string;
begin
  Result := 'Source Debugger';
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevSourceViewer.UpdateObserver;
var
  compUnit: TCompilationUnit;
  i, k: integer;
  v: TDwarfVariable;
  inReg, notOptimized: boolean;
  addr: uint32;
  node: TListItem;
begin
  memo.Refresh;

  if not assigned(dwarf) then Exit;

  with variableView.Items do begin
    BeginUpdate;
    Clear;

//  res.Add('Valid variables at PC = ' + IntToHex(vmCurrentPC, 8));

  for k := 0 to dwarf.compUnits.Count - 1 do begin
    compUnit := TCompilationUnit(dwarf.compUnits[k]);

    if (vmCurrentPC >= compUnit.lowPC) and (vmCurrentPC <= compUnit.highPC) then begin
      for i := 0 to compUnit.variables.Count - 1 do begin
        v := TDwarfVariable(compUnit.variables.Objects[i]);
        // attrib := FindAttribute(v.node, DW_AT_location);

        if Assigned(v.loc) and (v.startScope <= vmCurrentPC) then begin
          addr := LocationSM(v.loc.block, inReg, notOptimized);

          node := Add;
          node.Caption := v.name;
          if inReg then begin
            addr := addr and 15;
            node.SubItems.Add('0x' + IntToHex(vmGetRegister(addr), 8));
          end else begin
            node.SubItems.Add('0x' + IntToHex(vmReadWord(addr), 8));
          end;
        end;
      end;
    end;

  end;


    EndUpdate;
  end;

  UpdateLog;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevSourceViewer.memoStatusChange(Sender: TObject; Changes: TSynStatusChanges);
var
  st: string;
begin
  // Update the 1st panel to display the cursor position
  if (scCaretX in Changes) or (scCaretY in Changes) then begin
    st := Format('%9d: %-8d', [memo.CaretY, memo.CaretX]);
    status.Panels[0].Text := st;
  end;

  // Update the 2nd panel to display the state of the file (modified or not)
  if scModified in Changes then begin
    if memo.Modified then
      st := 'Modified'
    else
      st := '';
    status.Panels[1].Text := st;
  end;

  // Update the 3rd panel to display the edit mode
  if (scInsertMode in Changes) or (scReadOnly in Changes) then begin
    if memo.ReadOnly then
      st := 'Read only'
    else begin
      if memo.InsertMode then
        st := 'Insert'
      else
        st := 'Overwrite';
    end;
    status.Panels[2].Text := st;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevSourceViewer.FormCreate(Sender: TObject);
var
  index, temp: integer;
begin
  // Muck with the gutter stuff
  TDebugSupportPlugin.Create(Self);

  // Set up a few things
  jdevSourceViewer := self;
  cpuSourceDebug := false;
  cpuSourceDebug := true;
  vmSoftBreakpoints(cpuSourceDebug);
  amUpdating := false;

  // Start a null hierarchy for the file viewer
  SetupFileView;

  // Add the tabs and build the file viewer
  for index := 0 to fileList.count - 1 do begin
    temp := addTab(fileList.Strings[index]);
    AddToFileView(fileList.Strings[index], temp);
  end;

  // Make things double buffered
  fileView.DoubleBuffered := true;
  classView.DoubleBuffered := true;
  log.DoubleBuffered := true;
  variableView.DoubleBuffered := true;

  // Set up help
  HelpContext := LinkHelp('source_debugger.html');
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevSourceViewer.FormDestroy(Sender: TObject);
begin
  jdevSourceViewer := nil;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevSourceViewer.tabsChanging(Sender: TObject; var AllowChange: Boolean);
begin
  if tabs.tabIndex > -1 then
    (fileList.Objects[tabs.TabIndex] as TStringList).Assign(memo.Lines);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevSourceViewer.tabsChange(Sender: TObject);
var
  i: integer;
begin
  if tabs.tabIndex > -1 then begin
    if tabs.Tabs[tabs.tabIndex] = '!' then begin
      i := 0;
      while i < tabs.Tabs.Count do begin
        if tabs.Tabs[i] <> '!' then begin
          tabs.TabIndex := i;
          Exit;
        end;
        Inc(i);
      end;
    end;
    memo.Lines.Assign(fileList.Objects[tabs.TabIndex] as TStringList);

    BuildClassView;
  end {else
    Close;}
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevSourceViewer.goToLineNumber(Sender: TObject);
begin
  memo.TopLine := StrToIntDef(InputBox('Go to Line Number', 'Enter new line number:', IntToStr(memo.TopLine)), memo.TopLine);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevSourceViewer.FindPC1Click(Sender: TObject);
var
  hit: TLineHit;
begin
  if FindLineInP(vmCurrentPC, hit) then begin
    logWriteLn(Format('line: %d, column: %d, iss: %d, bb: %d, file: %s', [hit.line, hit.column, ord(hit.isStatement), ord(hit.basicBlock), hit.filename]));
    if Assigned(jdevSourceViewer) then begin
      focusFile(hit.filename);
      memo.CaretX := hit.column;
      memo.CaretY := hit.line;
      if (hit.line < uint32(memo.TopLine)) or (uint32(memo.LinesInWindow + memo.TopLine) > hit.line) then memo.TopLine := hit.line;
    end;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevSourceViewer.memoGutterClick(Sender: TObject; X, Y, Line: Integer; mark: TSynEditMark);
var
  addr: uint32;
  st: TStringList;
begin
  if tabs.TabIndex > -1 then begin
    st := fileList.Objects[tabs.TabIndex] as TStringList;
    addr := uint32(st.Objects[line-1]);
    if addr > 0 then begin
      if bpmHard in vmIsBreakpoint(addr) then
        vmRemoveBreakpoint(addr, [bpmHard])
      else
        vmAddBreakpoint(addr, false);
    end;
    memo.Refresh;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevSourceViewer.memoSpecialLineColors(Sender: TObject; Line: Integer; var Special: Boolean; var FG, BG: TColor);
var
  addr: uint32;
  st: TStringList;
begin
  if tabs.TabIndex > -1 then begin
    st := fileList.Objects[tabs.TabIndex] as TStringList;
    addr := uint32(st.Objects[line-1]);
    if addr = 0 then Exit;

    // Color the current line
    if addr = vmCurrentPC then begin
      Special := true;
      BG := memo.SelectedColor.Background;
      FG := memo.SelectedColor.Foreground;
    end;

    // Color a breakpoint
    if bpmHard in vmIsBreakpoint(addr) then begin
      Special := true;
      BG := clRed;
      FG := clWhite;
    end;
  end;
end;