observercsource.pas

一个不出名的GBA模拟器

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

procedure TjdevSourceViewer.PaintGutterGlyphs(ACanvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer);

function GetLineInfo(line: integer): TDebuggerLineInfos;
var
  addr: uint32;
  st: TStringList;
begin
  Result := [];

  if tabs.TabIndex > -1 then begin
    st := fileList.Objects[tabs.TabIndex] as TStringList;
    addr := uint32(st.Objects[line-1]);
    if addr > 0 then begin
      Result := Result + [dlExecutableLine];
      if bpmHard in vmIsBreakpoint(addr) then Result := Result + [dlBreakpointLine];
      if vmCurrentPC = addr then Result := Result + [dlCurrentLine];
    end;
  end;
end;

var
  LH, X, Y: integer;
  LI: TDebuggerLineInfos;
  ImgIndex: integer;
begin
  X := 4;
  LH := memo.LineHeight;
  Y := (LH - imglGutterGlyphs.Height) div 2 + LH * (FirstLine - memo.TopLine);
  while FirstLine <= LastLine do begin
    LI := GetLineInfo(FirstLine);
    if dlCurrentLine in LI then begin
      if dlBreakpointLine in LI then ImgIndex := 2 else ImgIndex := 1;
    end else if dlExecutableLine in LI then begin
      if dlBreakpointLine in LI then ImgIndex := 3 else ImgIndex := 0;
    end else begin
      if dlBreakpointLine in LI then ImgIndex := 4 else ImgIndex := -1;
    end;
    if ImgIndex >= 0 then
      imglGutterGlyphs.Draw(ACanvas, X, Y, ImgIndex);
    Inc(FirstLine);
    Inc(Y, LH);
  end;
end;

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

procedure FreeFiles;
var
  index: integer;
begin
  for index := 0 to fileList.Count - 1 do
    (fileList.Objects[index] as TStringList).Free;
  fileList.Clear;

  if jdevSourceViewer <> nil then begin
    jdevSourceViewer.tabs.Tabs.Clear;
    jdevSourceViewer.tabsChange(nil);
    jdevSourceViewer.SetupFileView;
  end;
end;

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

procedure FixCyg(var s: string);
var
  i: integer;
begin
  if Pos('cygdrive', s) > 0 then begin
    Delete(s, 1, 10);
    if Length(s) > 1 then s[2] := ':';
    Insert('\', s, 3);
  end;

  i := Pos('/', s);
  while i > 0 do begin
    s[i] := '\';
    i := Pos('/', s);
  end;
end;

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

function loadSourceFile(filename: string): TStringList;
var
  i, temp: integer;
  backup: string;
begin
  backup := filename;
  if Pos('/', filename) > 0 then FixCyg(filename);
  Result := nil;

  // Look for the file in the file list
  i := fileList.IndexOf(filename);
  if i > -1 then
    Result := TStringList(fileList.Objects[i])
  else begin
    // The file isn't already loaded, so do so
    if FileExists(filename) then begin
      Result := TStringList.Create;
      Result.LoadFromFile(filename);
      fileList.AddObject(filename, Result);

      // Add a tab to the source viewer if its open
      if Assigned(jdevSourceViewer) then begin
        jdevSourceViewer.targetFile := backup;
        temp := jdevSourceViewer.addTab(filename);
        jdevSourceViewer.AddToFileView(filename, temp);
      end;
    end {else
      fileList.AddObject(filename, nil)};
  end;
end;

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

function TjdevSourceViewer.addTab(filename: string): integer;
var
  st: string;
begin
  st := ExtractFilename(filename);
  if not FileExists(filename) then st := '!';
  tabs.TabIndex := tabs.Tabs.Add(st);
  Result := tabs.tabIndex;
  tabsChange(nil);
end;

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

procedure TjdevSourceViewer.focusFileTab(index: integer);
begin
  tabs.TabIndex := index;
end;

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

function focusFile(filename: string): TStringList;
var
  index: integer;
begin
  index := fileList.IndexOf(filename);
  if index > -1 then begin
    if jdevSourceViewer <> nil then jdevSourceViewer.focusFileTab(index);
    Result := fileList.Objects[index] as TStringList;
  end else
    Result := nil;
end;

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

function findFile(filename: string): TStringList;
var
  index: integer;
begin
  if Pos('/', filename) > 0 then FixCyg(filename);
  index := fileList.IndexOf(filename);
  if index > -1 then Result := TStringList(fileList.Objects[index]) else Result := nil;
end;

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

procedure closeSourceFiles;
begin
  FreeFiles;
end;

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

procedure TjdevSourceViewer.mStepClick(Sender: TObject);
begin
//  cpuActive := true;
end;

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

procedure TjdevSourceViewer.mToggleBreakpointClick(Sender: TObject);
begin
  memoGutterClick(Sender, 0, 0, memo.CaretY, nil);
end;

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

procedure TjdevSourceViewer.ChangeFont(Sender: TObject);
begin
//  fontDialog.Font.Assign(sourceDebuggerFont);
//  if fontDialog.Execute then sourceDebuggerFont.Assign(fontDialog.Font);
end;

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

procedure TjdevSourceViewer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  cpuSourceDebug := false;
  vmSoftBreakpoints(cpuSourceDebug);
end;

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

procedure TjdevSourceViewer.SetupFileView;
var
  i: integer;
begin
  with fileView.Items do begin
    BeginUpdate;
    Clear;
    fourNodes[0] := Add(nil, 'Source Files');
    fourNodes[1] := Add(nil, 'Assembler Files');
    fourNodes[2] := Add(nil, 'Header Files');
    fourNodes[3] := Add(nil, 'Resources');
    for i := 0 to 3 do fourNodes[i].data := pointer(-1);

    EndUpdate;
  end;
end;

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

procedure TjdevSourceViewer.AddToFileView(filename: string; tab: integer);
var
  ext: string;
  j: integer;
begin
  with fileView do begin
    ext := Uppercase(ExtractFileExt(filename));
         if (ext = '.C') or (ext = '.CPP') then j := 0
    else if (ext = '.S') or (ext = '.ASM') then j := 1
    else if (ext = '.H') or (ext = '.HPP') then j := 2
    else j := 3;

    with Items.AddChild(fourNodes[j], ExtractFileName(filename)) do begin
      Data := pointer(tab);
    end;
  end;
end;

(*    case attrib^.format of
      DW_FORM_addr: st := 'address $' + IntToHex(attrib^.address, 8);
      DW_FORM_block, DW_FORM_block1, DW_FORM_block2, DW_FORM_block4: st := 'block of size ' + IntToStr(attrib^.block.size);
      DW_FORM_sdata, DW_FORM_udata, DW_FORM_data1, DW_FORM_data2, DW_FORM_data4, DW_FORM_data8: st := 'data $' + IntToHex(attrib^.data, 8);
      DW_FORM_string, DW_FORM_strp: st := attrib^.st;
      DW_FORM_flag: if attrib^.flag then st := 'TRUE' else st := 'FALSE';
      DW_FORM_ref_addr: st := 'offset FINDME $' + IntToHex(attrib^.offset, 8);
      DW_FORM_ref_udata, DW_FORM_ref1, DW_FORM_ref2, DW_FORM_ref4, DW_FORM_ref8: st := 'offset $' + IntToHex(attrib^.offset, 8);
    end;

    tree.Items.AddChild(dnode, Format('%-30s', [DwarfAttributeToString(attrib^.name)]) + ' ' + st);*)

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

procedure TjdevSourceViewer.AttributeCV(node: PDwarfNode; var dnode: TTreeNode);
var
  attrib: PDwarfAttribute;
begin
  attrib := node^.attribs;
  while attrib <> nil do begin
    case attrib^.name of
      DW_AT_name: dnode.Text := attrib^.st;
      DW_AT_artificial: if attrib^.flag then begin
        classView.Items.Delete(dnode);
        dnode := nil;
        Exit;
      end;
      DW_AT_decl_file: begin
        if (integer(attrib^.data) <= currentUnit.files.Count) and (attrib^.data > 0) then begin
          if currentUnit.files.strings[attrib^.data - 1] <> targetFile then begin
            classView.Items.Delete(dnode);
            dnode := nil;
            Exit;
          end;
        end;
      end;
    end;
    attrib := attrib^.next;
  end;
end;

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

procedure TjdevSourceViewer.WalkCVNode(node: PDwarfNode; dnode: TTreeNode);
var
  temp: TTreeNode;
  doKids: boolean;
begin
  while node <> nil do begin
    temp := nil;
    doKids := false;
    case node^.tag of
      DW_TAG_variable: begin
        temp := classView.Items.AddChild(threeNodes[2], '<error>');
        temp.Data := node;
        AttributeCV(node, temp);
      end;
      DW_TAG_member: begin
        temp := classView.Items.AddChild(dnode, '<error>');
        temp.Data := node;
        AttributeCV(node, temp);
      end;
      DW_TAG_structure_type, DW_TAG_class_type: begin
        temp := classView.Items.AddChild(nil, '<error>');
        temp.Data := node;
        AttributeCV(node, temp);
        doKids := true;
      end;
      DW_TAG_compile_unit: doKids := true;

           {
      DW_TAG_array_type, DW_TAG_enumeration_type,
      DW_TAG_pointer_type, DW_TAG_reference_type, DW_TAG_string_type,
      DW_TAG_subroutine_type, DW_TAG_typedef, DW_TAG_union_type,
      DW_TAG_ptr_to_member_type, DW_TAG_set_type, DW_TAG_subrange_type,
      DW_TAG_base_type, DW_TAG_const_type, DW_TAG_packed_type, DW_TAG_volatile_type: begin
        temp := classView.Items.AddChild(threeNodes[1], '<error>');
        temp.Data := node;
        AttributeCV(node, temp);
      end;  }

      DW_TAG_subprogram: begin
        if dnode = nil then
          temp := classView.Items.AddChild(threeNodes[0], '<error>')
        else
          temp := classView.Items.AddChild(dnode, '<error>');
        temp.Data := node;
        AttributeCV(node, temp);
      end;

    end;

    if temp = nil then temp := dnode;
    if node.hasChildren and doKids then WalkCVNode(node^.kids, temp);

    node := node^.next;
  end;
end;

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

procedure TjdevSourceViewer.BuildClassView;
var
  i: integer;
begin
  Exit; // fixme, findme: this is just too expensive

  if dwarf = nil then Exit;//  targetFile := tab

//  targetFile := 2;

  with classView.Items do begin
    BeginUpdate;
    Clear;

    threeNodes[0] := Add(nil, 'Functions');
    threeNodes[1] := Add(nil, 'Types');
    threeNodes[2] := Add(nil, 'Globals');
    for i := 0 to 2 do threeNodes[i].data := pointer(-1);

    for i := 0 to dwarf.CompUnits.Count - 1 do begin
      currentUnit := TCompilationUnit(dwarf.CompUnits.Items[i]);
      WalkCVNode(currentUnit.rootNode, nil);
    end;

    EndUpdate;
  end;
end;

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

procedure TjdevSourceViewer.fileViewGetImageIndex(Sender: TObject; Node: TTreeNode);
begin
  if integer(Node.Data) < 0 then
    Node.ImageIndex := Ord(node.Expanded)
  else
    Node.ImageIndex := 2;
  Node.SelectedIndex := Node.ImageIndex;
end;

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

procedure TjdevSourceViewer.fileViewClick(Sender: TObject);
var
  i: integer;
begin
  if fileView.Selected <> nil then begin
    i := integer(fileView.Selected.Data);
    if i > -1 then begin
      tabs.tabIndex := i;
      tabsChange(nil);
    end;
  end;
end;

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

procedure TjdevSourceViewer.UpdateLog;
var
  i: integer;
begin
  if not amUpdating then begin
    amUpdating := true;

    i := Max(1, log.Height div log.ItemHeight - 1);
    log.Items.BeginUpdate;
    log.Items.Clear;
    logGetEntries(logNumEntries, i, log.Items);
    log.Items.EndUpdate;

    amUpdating := false;
  end;
end;

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

procedure TjdevSourceViewer.classViewClick(Sender: TObject);
var
  node: PDwarfNode;
  a: PDwarfAttribute;
begin
  if classView.Selected <> nil then begin
    node := classView.Selected.Data;
    if (node <> nil) and (integer(node) <> -1) then begin

      a := FindAttribute(node, DW_AT_decl_line);
      if a <> nil then begin
        memo.TopLine := a^.data;
      end;

    end;
  end;
end;

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

initialization
  jdevSourceViewer := nil;
  fileList := TStringList.Create;
  RegisterViewer(TjdevSourceViewer);
finalization
  FreeFiles;
  fileList.Free;
end.

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