observerdisassembler.pas

一个不出名的GBA模拟器

  // Try to extract a number at the cursor position
  if (y > 0) and (y <= listing.Lines.Count) then begin
    l := listing.Lines[y-1];

    if x > 18 then begin
      x1 := x;
      while (x > 0) and (l[x] <> ' ') do Dec(x);
      while (x1 <= Length(l)) and (l[x1] <> ' ') do Inc(x1);
      Inc(x);
      l := Trim(Copy(l, x, x1-x+1));
      while (Length(l) > 0) and (l[1] in ['#', '=', ',']) do Delete(l, 1, 1);
      if (Length(l) > 0) and (l[1] <> '$') then l := '$' + l;

      // Alter the cursor based on if it is a valid number
      if StrToIntDef(l, MaxInt) <> MaxInt then
        listing.Cursor := crHandPoint
      else
        listing.Cursor := crDefault;
    end;
  end;}
end;

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

procedure TjdevDisassembler.ReturnToCurrentPC(Sender: TObject);
begin
  CalculateDelta;
  scrollbar.Position := vmCurrentPC - uint32(linesInDisasm * delta) shr 1;
end;

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

procedure TjdevDisassembler.IncrementRegister(Sender: TObject);
var
  index: integer;
begin
  index := regDisplay.ItemIndex;
  if index > -1 then begin
    vmSetRegister(index, vmGetRegister(index) + 1);
    UpdateObserver;
  end;
end;

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

procedure TjdevDisassembler.DecrementRegister(Sender: TObject);
var
  index: integer;
begin
  index := regDisplay.ItemIndex;
  if index > -1 then begin
    vmSetRegister(index, vmGetRegister(index) - 1);
    UpdateObserver;
  end;
end;

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

procedure TjdevDisassembler.ZeroRegister(Sender: TObject);
var
  index: integer;
begin
  index := regDisplay.ItemIndex;
  if index > -1 then begin
    vmSetRegister(index, 0);
    UpdateObserver;
  end;
end;

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

procedure TjdevDisassembler.ChangeRegister(Sender: TObject);
var
  index: integer;
begin
  index := regDisplay.ItemIndex;
  if index > -1 then begin
    regEditor.Top := index * regEditor.height;
    regEditor.visible := true;
    regEditor.Text := IntToHex(vmGetRegister(index), 8);
    regEditing := index;
    UpdateObserver;
  end;
end;

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

procedure TjdevDisassembler.MarkTheRegisters;
begin
  Move(lastRegs, marked, SizeOf(TvmRegisterFile));
end;

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

procedure TjdevDisassembler.MarkRegisters(Sender: TObject);
begin
  amMarked := not amMarked;
  mMarkRegisters.Checked := amMarked;
  if amMarked then markTheRegisters;
end;

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

procedure TjdevDisassembler.regDisplayClick(Sender: TObject);
var
  key: char;
begin
  if regEditor.Visible then begin
    key := #10;
    regEditorKeyPress(Sender, key);
  end;
end;

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

procedure TjdevDisassembler.regEditorKeyPress(Sender: TObject; var Key: Char);
var
  st: string;
begin
  if (key = #10) or (key = #13) then begin
    st := Trim(regEditor.Text);
    if (Length(st) > 0) and (st[1] <> '$') then st := '$' + st;
    vmSetRegister(regEditing, StrToIntDef(st, vmGetRegister(regEditing)));
    regEditor.Visible := false;
    regEditor.Top := -regEditor.height;
    regEditing := -1;

    UpdateObserver;
  end;
end;

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

procedure TjdevDisassembler.conditionDisplayClickCheck(Sender: TObject);
var
  r: uint32;
  i: integer;
begin
  r := vmGetRegister(16) and $0FFFFFFF;
  for i := 0 to 3 do
    if conditionDisplay.Checked[i] then r := r or (SR_N shr i);
  vmSetRegister(16, r);
  UpdateObserver;
end;

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

procedure TjdevDisassembler.flagsDisplayClickCheck(Sender: TObject);
var
  r: uint32;
  i: integer;
begin
  r := vmGetRegister(16) and ($FFFFFFFF-SR_I-SR_F-SR_T);
  for i := 0 to 2 do
    if flagsDisplay.Checked[i] then r := r or (SR_I shr i);
  vmSetRegister(16, r);
  UpdateObserver;
end;

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

procedure TjdevDisassembler.regDisplayDblClick(Sender: TObject);
begin
  if not regEditor.Visible then changeRegister(Sender);
end;

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

procedure TjdevDisassembler.listboxMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
begin
//  if not amUpdating then
  Height := listbox.ItemHeight;

  if index < lastList.Count then
    if bpmSoft in vmIsBreakpoint(uint32(lastList.objects[index])) then
      Height := Height*2;
end;

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

procedure TjdevDisassembler.listboxDrawItem(Control: TWinControl; Index: Integer; aRect: TRect; State: TOwnerDrawState);
var
  hit: TLineHit;
  stx: TStringList;
  x, y: integer;
  needRect: boolean;
  addr: uint32;
  st: string;
  bp: TBreakpoint;
begin
//  listbox.Canvas.FillRect(Rect);
  x := aRect.Left + 4;
  y := aRect.Top;

  needRect := true;
  addr := uint32(lastList.objects[index]);
  if bpmSoft in vmIsBreakpoint(addr) then begin
    if FindLineInP(addr, hit) then begin
      stx := findFile(hit.filename);
      if (hit.line > 0) and (stx <> nil) then begin
        listbox.Canvas.Font.Style := listbox.Font.Style + [fsBold];
        if (integer(hit.line) <= stx.Count) and (hit.line > 0) then st := TrimLeft(stx.Strings[hit.line-1]) else st := '';
        listbox.Canvas.TextRect(arect, x, y, Format('%s.%d: %s', [ExtractFilename(hit.filename), hit.line, st]));
        y := y + listbox.ItemHeight;
        listbox.Canvas.Font.Style := listbox.Font.Style - [fsBold];
        needRect := false;
      end;
    end;
  end;

  if index < lastList.Count then st := lastList.strings[index] else st := '';

  if needRect then
    listbox.Canvas.TextRect(aRect, x, y, st)
  else
    listbox.Canvas.TextOut(x, y, st);

  // Add a few glyphs
  Inc(Y, 1);
  bp := FindBreakpoint(addr);
  if bp <> nil then begin
    if bp.enabled then
      imglGutterGlyphs.Draw(gutter.Canvas, 1, Y, 3)
    else
      imglGutterGlyphs.Draw(gutter.Canvas, 1, Y, 5);
  end;

  if addr = vmCurrentPC then imglGutterGlyphs.Draw(gutter.Canvas, 16, Y, 1);

  if index = listbox.Items.count-1 then
    if (lastI < lastList.Count) and (lastI > 0) then
      listboxDrawItem(listBox, lastI, Rect(0, lastY, listBox.width, listBox.height), [odDefault]);
end;

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

function TjdevDisassembler.linesInDisasm: integer;
begin
  Result := listbox.Height div listbox.ItemHeight;
end;

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

procedure TjdevDisassembler.CalculateDelta;
var
  inThumbMode: boolean;
begin
  // Set up the disassembler
  if mDisasmFollowsCPU.Checked then begin
    // Disasm in current CPU mode, follow the CPU
    inThumbMode := vmGetRegister(CPSR) and SR_T <> 0;
    if inThumbMode then begin
      delta := 2;
      scrollbar.Position := scrollbar.Position and not 1;
    end else begin
      delta := 4;
      scrollbar.Position := scrollbar.Position and not 3;
    end;
    disassembler.thumbMode := inThumbMode;

    if following and ((vmCurrentPC < uint32(scrollbar.Position)) or (vmCurrentPC > uint32(scrollbar.Position + linesInDisasm*delta))) then scrollbar.Position := vmCurrentPC;
  end else if mDisasmInARM.Checked then begin
    // Disasm in ARM, don't follow the PC
    delta := 4;
    scrollbar.Position := scrollbar.Position and not 3;
    disassembler.thumbMode := false;
  end else begin
    // Disasm in thumb, don't follow the PC
    delta := 2;
    scrollbar.Position := scrollbar.Position and not 1;
    disassembler.thumbMode := true;
  end;
end;

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

procedure TjdevDisassembler.ToggleShowExactOpcodes(Sender: TObject);
begin
  mShowExactOpcodes.Checked := not mShowExactOpcodes.Checked;
  ShowExactOpcodes := mShowExactOpcodes.Checked;
  UpdateObserver;
end;

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

procedure TjdevDisassembler.regDisplayDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  last: TColor;
  stA, stB: string;
  x, y: integer;
begin
  stB := regDisplay.Items[index];
  stA := Copy(stB, 1, 5);
  Delete(stB, 1, 5);

  x := 2;
  y := index*regDisplay.ItemHeight;
  regDisplay.Canvas.TextRect(Rect, x, y, stA);

  x := x + regDisplay.Canvas.TextWidth(stA);
  last := regDisplay.Canvas.Font.Color;
  if amMarked and (lastRegs.regs[index] <> marked.regs[index]) then regDisplay.Canvas.Font.Color := clRed;
  regDisplay.Canvas.TextOut(x, y, stB);
  regDisplay.Canvas.Font.Color := last;
end;

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

procedure TjdevDisassembler.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  addr: uint32;
  ty, i: integer;
  bp: TBreakpoint;
begin
  ty := 0;
  i := -1;
  repeat
    Inc(i);
    Inc(ty, listbox.ItemHeight);
    if i < lastList.Count then
      if bpmSoft in vmIsBreakpoint(uint32(lastList.objects[i])) then
        Inc(ty, listbox.ItemHeight);
  until ty > Y;

  if i < listbox.Items.Count then begin
    if i < lastList.Count then begin
      addr := uint32(lastList.Objects[i]);

      bp := FindBreakpoint(addr);
      if bp <> nil then
        RemoveBreakpoint(bp)
      else begin
        bp := TBreakpoint.Create;
        bp.address := addr;
        bp.enabled := true;
        AddBreakpoint(bp);
      end;
      gutter.Refresh;
      listbox.Refresh;

      following := false;
      UpdateListing;
    end;
  end;
end;

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

procedure TjdevDisassembler.AddLabel(Sender: TObject);
var
  addr: uint32;
begin
  if listbox.ItemIndex > -1 then begin
    addr := uint32(listbox.Items.Objects[listbox.ItemIndex]);
    disassembler.AddMapping(addr, InputBox('Mappy VM', 'Enter a label for this address.', 'l' + IntToHex(addr, 8)));
    UpdateObserver;
  end;
end;

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

procedure TjdevDisassembler.RemoveLabel(Sender: TObject);
var
  addr: uint32;
begin
  if listbox.ItemIndex > -1 then begin
    addr := uint32(listbox.Items.Objects[listbox.ItemIndex]);
    disassembler.RemoveMapping(addr);
    UpdateObserver;
  end;
end;

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

procedure TjdevDisassembler.ChangeFont(Sender: TObject);
begin
  if fontString <> '' then StringToFont(fontString, fontDialog.Font);
  if fontDialog.Execute then begin
    fontString := FontToString(fontDialog.Font);
    if fontString <> '' then StringToFont(fontString, Font);
  end;
end;

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

procedure TjdevDisassembler.FormShow(Sender: TObject);
begin
  if fontString <> '' then StringToFont(fontString, Font);
  mShowExactOpcodes.Checked := ShowExactOpcodes;

  // Load the translation
  LoadTranslation(self, translation);
  UpdateObserver;
end;

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

procedure TjdevDisassembler.LoadSettings(ini: TIniFile);
begin
  inherited;
  fontString := ini.ReadString(OCaption, 'Font', '');
  ShowExactOpcodes := ini.ReadBool(OCaption, 'ShowExactOpcodes', false);
end;

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

procedure TjdevDisassembler.SaveSettings(ini: TIniFile);
begin
  inherited;
  ini.WriteString(OCaption, 'Font', fontString);
  ini.WriteBool(OCaption, 'ShowExactOpcodes', ShowExactOpcodes);
end;

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

procedure TjdevDisassembler.ShowMenu(Sender: TObject);
var
  mouse: TPoint;
begin
  GetCursorPos(mouse);
  listingMenu.Popup(mouse.x, mouse.y);
end;

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

procedure TjdevDisassembler.ShowHelp(Sender: TObject);
begin
  ShowWebPage(helpFiles.strings[HelpContext-1]);
end;

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

initialization
  RegisterViewer(TjdevDisassembler);
end.

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