{
DisassemblerWindow используется для создания окна, в котором пользователь
смотрит внутреннее устройство выполняемой Малик Эмулятором программы:
дизассемблер, регистры, стак, глобальные переменные, точки останова и прочее.
Этот исходный текст является частью Малик Эмулятора.
Следующие файлы используются этим исходным текстом:
disassemblerwindow.lfm
На них так же распространяются те же права, как и на этот исходный текст.
Copyright © 2016–2017, 2019–2023 Малик Разработчик
Малик Эмулятор – свободная программа: вы можете перераспространять её и/или
изменять её на условиях Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Малик Эмулятор распространяется в надежде, что он может быть полезен,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
общественной лицензии GNU.
Вы должны были получить копию Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit DisassemblerWindow;
{$MODE DELPHI}
interface
uses
Windows,
Themes,
Classes,
SysUtils,
Forms,
Graphics,
Controls,
ComCtrls,
ExtCtrls,
StdCtrls,
Buttons,
Menus,
LCLType,
Lang,
FileIO,
EmulProgrammes,
EmulMalik,
EmulatorInterfaces;
{%region public }
const
PREFIX_CLASS = 'class:';
PREFIX_VARIABLE = 'var:';
PREFIX_FUNCTION = 'func:';
type
DefaultRepresenter = class;
DebugInfo = class;
ClassDebugInfo = class;
DisassemblerObject = class;
GUIElement = class;
ClickableGUIElement = class;
FieldInfo = class;
DebugInspectorHistoryElement = class;
DebugInspectorHistory = class;
TDisassemblerForm = class;
GUIElementDisassembler = class;
GUIElementGlobalVariables = class;
GUIElementAllClasses = class;
GUIElementAllFunctions = class;
GUIElementExceptions = class;
GUIElementBreakpoints = class;
GUIElementContext = class;
GUIElementStack = class;
GUIElementCallStack = class;
DebugInfo_Array1d = array of DebugInfo;
ClassDebugInfo_Array1d = array of ClassDebugInfo;
GUIElement_Array1d = array of GUIElement;
DebugInspectorHistoryElement_Array1d = array of DebugInspectorHistoryElement;
DebugInspectorHistory_Array1d = array of DebugInspectorHistory;
DefaultRepresenter = class(RefCountInterfacedObject, Representer)
public
constructor create();
function getUntypedValueRepresentation(): AnsiString; virtual;
function getLongRepresentation(value: long; sourceType: int): AnsiString; virtual;
function getFloatRepresentation(value: float): AnsiString; virtual;
function getDoubleRepresentation(value: double): AnsiString; virtual;
function getRealRepresentation(value: real): AnsiString; overload; virtual;
function getRealRepresentation(value: real; sourceType: int): AnsiString; overload; virtual;
function getObjectRepresentation(value: int): AnsiString; virtual;
function getHexRepresentation(value: int): AnsiString; virtual;
function getTypeRepresentation(const rawRepresentation: AnsiString): AnsiString; virtual;
end;
DebugInfo = class(_Object)
strict private
address: int;
info: AnsiString;
public
constructor create(address: int; const info: AnsiString);
function getAddress(): int;
function getInfo(): AnsiString;
end;
ClassDebugInfo = class(DebugInfo)
strict private
parent: ClassDebugInfo;
fields: DebugInfo_Array1d;
count: int;
public
constructor create(address: int; const info: AnsiString);
destructor destroy; override;
function getParentsCount(): int;
function getFieldsCount(): int;
function getField(index: int): DebugInfo;
function getParent(): ClassDebugInfo;
procedure addField(offset: int; const info: AnsiString);
procedure setParent(parent: ClassDebugInfo);
end;
DisassemblerObject = class(_Object)
protected
TDisassemblerForm_self: TDisassemblerForm;
public
constructor create(TDisassemblerForm_self: TDisassemblerForm);
end;
GUIElement = class(DisassemblerObject)
private
box: TPaintBox;
scroll: TScrollBar;
position: int;
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paint(canvas: TCanvas; width, height, scrollPosition: int); virtual; abstract;
procedure pointerPressed(x, y: int; auxButton: boolean); virtual;
procedure pointerReleased(x, y: int; auxButton: boolean); virtual;
function getLinesCount(): int; virtual;
procedure repaint();
end;
ClickableGUIElement = class(GUIElement)
private
paintedFromLine: int;
lineHeight: int;
clickedLine: int;
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean); virtual; abstract;
procedure paint(canvas: TCanvas; width, height, scrollPosition: int); override;
procedure pointerPressed(x, y: int; auxButton: boolean); override; final;
procedure pointerReleased(x, y: int; auxButton: boolean); override; final;
procedure lineClicked(lineIndex: int; auxButton: boolean); virtual;
end;
FieldInfo = class(_Object)
private
fieldAddress: int;
fieldDataType: AnsiString;
fieldRepresentation: AnsiString;
valueRepresentation: AnsiString;
color: int;
public
constructor create();
end;
DebugInspectorHistoryElement = class(DisassemblerObject)
strict private
dataType: AnsiString;
address: int;
private
position: int;
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; const dataType: AnsiString; address: int);
function getTypeRepresentation(): AnsiString;
function getValueRepresentation(): AnsiString;
function getFieldInfo(index: int; info: FieldInfo): boolean;
function getFieldsCount(): int;
function getAddress(): int;
function getClassInfo(): ClassDebugInfo;
function isObjectType(): boolean;
end;
DebugInspectorHistory = class(ClickableGUIElement)
strict private
menu: TPopupMenu;
field: FieldInfo;
history: DebugInspectorHistoryElement_Array1d;
count: int;
current: int;
procedure insert(const dataType: AnsiString; address: int);
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar; const dataType: AnsiString; address: int);
destructor destroy; override;
procedure paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean); override;
procedure paint(canvas: TCanvas; width, height, scrollPosition: int); override;
procedure lineClicked(lineIndex: int; auxButton: boolean); override;
function getLinesCount(): int; override;
procedure gotoPrevElement();
procedure gotoNextElement();
procedure gotoElement(index: int);
function getElementRepresentation(index: int): AnsiString;
function getCurrentIndex(): int;
function getCount(): int;
function getMenu(): TPopupMenu;
end;
TDisassemblerForm = class(TForm)
arrows: TImageList;
controlPanel: TPanel;
debugInspectorButton: TSpeedButton;
stepIntoButton: TSpeedButton;
stepOverButton: TSpeedButton;
runButton: TSpeedButton;
hideAndRunButton: TSpeedButton;
controlBevel: TBevel;
mainPanel: TPanel;
disassemblerPanel: TPanel;
disassembler: TPaintBox;
disassemblerScrollbar: TScrollBar;
mainPanelSplitter: TSplitter;
statusPanel: TPanel;
statusPages: TPageControl;
statusGlobalVariables: TTabSheet;
statusAllClasses: TTabSheet;
statusAllFunctions: TTabSheet;
statusExceptions: TTabSheet;
statusBreakpoints: TTabSheet;
statusBox: TPanel;
status: TPaintBox;
statusScrollbar: TScrollBar;
mainSplitter: TSplitter;
threadPanel: TPanel;
threadList: TComboBox;
contextSplitter: TPanel;
contextPanel: TPanel;
context: TPaintBox;
contextScrollbar: TScrollBar;
stackSplitter: TSplitter;
stackPanel: TPanel;
stackPages: TPageControl;
stackAll: TTabSheet;
stackCalls: TTabSheet;
stackBox: TPanel;
stack: TPaintBox;
stackScrollbar: TScrollBar;
debugInspectorPanel: TPanel;
debugInspectorCaption: TPanel;
debugInspectorCloseButton: TSpeedButton;
debugInspectorPages: TPageControl;
debugInspectorVarInfo: TPanel;
debugInspectorBackButton: TSpeedButton;
debugInspectorNextButton: TSpeedButton;
debugInspectorMenuButton: TSpeedButton;
debugInspectorCloseTabButton: TSpeedButton;
debugInspectorAddressLabel: TLabel;
debugInspectorAddress: TLabel;
debugInspectorClassLabel: TLabel;
debugInspectorClass: TLabel;
debugInspectorValueLabel: TLabel;
debugInspectorValue: TLabel;
debugInspectorBox: TPanel;
debugInspector: TPaintBox;
debugInspectorScrollBox: TPanel;
debugInspectorScrollbar: TScrollBar;
debugInspectorSizeGrip: TPaintBox;
procedure formShow(sender: TObject);
procedure formKeyDown(sender: TObject; var key: Word; shift: TShiftState);
procedure formKeyUp(sender: TObject; var key: Word; shift: TShiftState);
procedure formResize(sender: TObject);
procedure formWindowStateChange(sender: TObject);
procedure formGUIElementPaint(sender: TObject);
procedure formGUIElementPointerPressed(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: integer);
procedure formGUIElementPointerReleased(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: integer);
procedure formGUIElementScroll(sender: TObject);
procedure stepIntoButtonClick(sender: TObject);
procedure stepOverButtonClick(sender: TObject);
procedure runButtonClick(sender: TObject);
procedure hideAndRunButtonClick(sender: TObject);
procedure debugInspectorButtonClick(sender: TObject);
procedure disassemblerScrollbarKeyDown(sender: TObject; var key: Word; shift: TShiftState);
procedure disassemblerScrollbarScroll(sender: TObject; action: TScrollCode; var position: integer);
procedure threadListSelect(sender: TObject);
procedure debugInspectorCaptionSizeGripMouseDown(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: integer);
procedure debugInspectorCaptionSizeGripMouseMove(sender: TObject; shift: TShiftState; x, y: integer);
procedure debugInspectorBackButtonClick(sender: TObject);
procedure debugInspectorNextButtonClick(sender: TObject);
procedure debugInspectorMenuButtonClick(sender: TObject);
procedure debugInspectorCloseTabButtonClick(sender: TObject);
procedure debugInspectorSizeGripPaint(sender: TObject);
procedure debugInspectorHistoryMenuClickItem(sender: TObject);
private
owner: EmulationWindowInterface;
resizing: boolean;
x: int;
y: int;
contextID: int;
stepInto: boolean;
stepOver: int;
disassemblerPosition: int;
maxVisibleAddress: int;
breakpointsCount: int;
image: TBitmap;
processor: MalikProcessor;
currentContext: MalikDebugContext;
allDebugInfo: DebugInfo_Array1d;
classesInfo: ClassDebugInfo_Array1d;
variablesInfo: DebugInfo_Array1d;
functionsInfo: DebugInfo_Array1d;
breakpoints: int_Array1d;
addresses: int_Array1d;
guiDisassembler: GUIElement;
guiStatus: GUIElement_Array1d;
guiContext: GUIElement;
guiStack: GUIElement_Array1d;
guiDebugInspector: DebugInspectorHistory_Array1d;
guiDebugInspectorCount: int;
function findClassInfo(const className: AnsiString): ClassDebugInfo;
function getDebugInfo(address: int; const info: DebugInfo_Array1d): AnsiString;
function getClassInfo(address: int; const info: ClassDebugInfo_Array1d): ClassDebugInfo;
function getFunctionAt(address: int): DebugInfo;
function getAddressRepresentation(address: int): AnsiString;
function getValueRepresentation(address: int; const typeInfo: AnsiString): AnsiString;
function getInstructionByteCode(address: int): AnsiString;
function getInstructionRepresentation(address: int): AnsiString;
function getInstructionLength(address: int): int;
function getInstructionsCount(address, size: int): int;
function getGUIElementFor(sender: TObject): GUIElement;
function hasBreakpointAt(address: int): boolean;
procedure updateScreen();
procedure showContext(id: int);
procedure addDebugInspectorElement(const tabCaption, dataType: AnsiString; address: int);
procedure paintGUIElement(element: GUIElement);
procedure destroyGUI(const arr: GUIElement_Array1d); overload;
procedure destroyGUI(const arr: DebugInspectorHistory_Array1d); overload;
procedure destroyInfo(const arr: DebugInfo_Array1d); overload;
procedure destroyInfo(const arr: ClassDebugInfo_Array1d); overload;
procedure loadDataFrom(strs: TStrings);
procedure setupScrollbar(scrollbar: TScrollBar; maxval, position: int); overload;
procedure setupScrollbar(scrollbar: TScrollBar; page: int); overload;
procedure switchFullScreenMode();
private
colorEmptyData: int;
colorNormalData: int;
colorObjectData: int;
colorExceptData: int;
colorOldEBPData: int;
colorReturnData: int;
colorIReturnData: int;
colorNormalType: int;
colorObjectType: int;
colorExceptType: int;
colorOldEBPType: int;
colorReturnType: int;
colorIReturnType: int;
colorOverflowType: int;
colorFunctionName: int;
colorSourceLine: int;
colorInherited: int;
public
constructor create(theOwner: TComponent); override;
destructor destroy; override;
procedure afterConstruction(); override;
procedure loadData();
procedure showContents(contextID: int);
function hasBreakpoints(): boolean;
function mustBreak(contextID, address: int): boolean;
strict private
INSTRUCTIONS_NAMES: AnsiString_Array1d; static;
private
class procedure clinit();
class procedure cldone();
public
DATA_REPRESENTER: Representer; static;
class function getFieldRepresentation(const fieldDebugInfoLine: AnsiString): AnsiString;
class function getVariableRepresentation(const variableDebugInfoLine: AnsiString): AnsiString;
class function getFunctionRepresentation(const functionDebugInfoLine: AnsiString): AnsiString;
end;
GUIElementDisassembler = class(GUIElement)
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paint(canvas: TCanvas; width, height, scrollPosition: int); override;
procedure pointerPressed(x, y: int; auxButton: boolean); override;
end;
GUIElementGlobalVariables = class(ClickableGUIElement)
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean); override;
procedure paint(canvas: TCanvas; width, height, scrollPosition: int); override;
procedure lineClicked(lineIndex: int; auxButton: boolean); override;
function getLinesCount(): int; override;
end;
GUIElementAllClasses = class(ClickableGUIElement)
strict private
classesRegion: int;
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean); override;
procedure lineClicked(lineIndex: int; auxButton: boolean); override;
function getLinesCount(): int; override;
end;
GUIElementAllFunctions = class(ClickableGUIElement)
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean); override;
procedure lineClicked(lineIndex: int; auxButton: boolean); override;
function getLinesCount(): int; override;
end;
GUIElementExceptions = class(ClickableGUIElement)
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean); override;
procedure paint(canvas: TCanvas; width, height, scrollPosition: int); override;
procedure lineClicked(lineIndex: int; auxButton: boolean); override;
function getLinesCount(): int; override;
end;
GUIElementBreakpoints = class(ClickableGUIElement)
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean); override;
procedure lineClicked(lineIndex: int; auxButton: boolean); override;
function getLinesCount(): int; override;
end;
GUIElementContext = class(ClickableGUIElement)
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean); override;
procedure paint(canvas: TCanvas; width, height, scrollPosition: int); override;
procedure lineClicked(lineIndex: int; auxButton: boolean); override;
function getLinesCount(): int; override;
end;
GUIElementStack = class(ClickableGUIElement)
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean); override;
procedure paint(canvas: TCanvas; width, height, scrollPosition: int); override;
procedure lineClicked(lineIndex: int; auxButton: boolean); override;
function getLinesCount(): int; override;
end;
GUIElementCallStack = class(ClickableGUIElement)
strict private
addresses: int_Array1d;
public
constructor create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
procedure paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean); override;
procedure paint(canvas: TCanvas; width, height, scrollPosition: int); override;
procedure lineClicked(lineIndex: int; auxButton: boolean); override;
function getLinesCount(): int; override;
end;
{%endregion}
implementation
{$R *.LFM}
{%region routine }
function DebugInfo_Array1d_create(length: int): DebugInfo_Array1d;
begin
setLength(result, length);
end;
procedure arraycopy(const src: DebugInfo_Array1d; srcOffset: int; const dst: DebugInfo_Array1d; dstOffset: int; length: int); overload;
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(_Object));
end;
function ClassDebugInfo_Array1d_create(length: int): ClassDebugInfo_Array1d;
begin
setLength(result, length);
end;
function GUIElement_Array1d_create(length: int): GUIElement_Array1d;
begin
setLength(result, length);
end;
function toGUIElementArray1d(const arr: array of GUIElement): GUIElement_Array1d;
begin
setLength(result, length(arr));
move(arr[0], result[0], length(result) * sizeof(_Object));
end;
function DebugInspectorHistoryElement_Array1d_create(length: int): DebugInspectorHistoryElement_Array1d;
begin
setLength(result, length);
end;
procedure arraycopy(const src: DebugInspectorHistoryElement_Array1d; srcOffset: int; const dst: DebugInspectorHistoryElement_Array1d; dstOffset: int; length: int); overload;
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(_Object));
end;
function DebugInspectorHistory_Array1d_create(length: int): DebugInspectorHistory_Array1d;
begin
setLength(result, length);
end;
procedure arraycopy(const src: DebugInspectorHistory_Array1d; srcOffset: int; const dst: DebugInspectorHistory_Array1d; dstOffset: int; length: int); overload;
var
lim: int;
len: int;
begin
lim := srcOffset + length;
len := System.length(src);
if (lim > len) or (lim < srcOffset) or (srcOffset < 0) or (srcOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
lim := dstOffset + length;
len := System.length(dst);
if (lim > len) or (lim < dstOffset) or (dstOffset < 0) or (dstOffset > len) then begin
raise ArrayIndexOutOfBoundsException.create('arraycopy: индекс элемента массива выходит из диапазона.');
end;
move(src[srcOffset], dst[dstOffset], length * sizeof(_Object));
end;
function typeSize(const rawRepresentation: AnsiString): int;
begin
if length(rawRepresentation) <= 0 then begin
result := 0;
exit;
end;
case rawRepresentation[1] of
SIGNATURE_VOID: begin
result := 0;
end;
SIGNATURE_BOOLEAN, SIGNATURE_BYTE: begin
result := 1;
end;
SIGNATURE_SHORT, SIGNATURE_WCHAR: begin
result := 2;
end;
SIGNATURE_OBJECT, SIGNATURE_CLASS, SIGNATURE_ARRAY,
SIGNATURE_INT, SIGNATURE_ICHAR, SIGNATURE_FLOAT: begin
result := 4;
end;
SIGNATURE_LONG, SIGNATURE_DOUBLE: begin
result := 8;
end;
SIGNATURE_REAL: begin
result := 10;
end;
else
result := 0;
end;
end;
{%endregion}
{%region DefaultRepresenter }
constructor DefaultRepresenter.create();
begin
inherited create();
end;
function DefaultRepresenter.getUntypedValueRepresentation(): AnsiString;
begin
result := '<пусто>';
end;
function DefaultRepresenter.getLongRepresentation(value: long; sourceType: int): AnsiString;
var
cc: int;
s: UnicodeString;
begin
case sourceType of
DATA_TYPE_BOOLEAN: begin
if value <> 0 then begin
result := 'true';
if int(value and $ff) <> 1 then begin
result := result + ' ($' + toHexString(value and $ff, 2) + ')';
end;
end else begin
result := 'false';
end;
end;
DATA_TYPE_BYTE: begin
result := toDecString(byte(value)) + ' ($' + toHexString(value and $ff, 1) + ')';
end;
DATA_TYPE_SHORT: begin
result := toDecString(short(value)) + ' ($' + toHexString(value and $ffff, 1) + ')';
end;
DATA_TYPE_INT: begin
result := toDecString(int(value)) + ' ($' + toHexString(zeroExtend(int(value)), 1) + ')';
end;
DATA_TYPE_LONG: begin
result := toDecString(value) + ' ($' + toHexString(value, 1) + ')';
end;
DATA_TYPE_WCHAR: begin
cc := int(value) and $ffff;
result := toDecString(cc) + ' ($' + toHexString(cc, 4);
if (cc < $d800) or (cc >= $e000) then begin
result := result + ', ''' + toUTF8String(wchar(cc)) + '''';
end;
result := result + ')';
end;
DATA_TYPE_ICHAR: begin
cc := int(value);
result := toDecString(cc) + ' ($' + toHexString(zeroExtend(cc), 4);
if (cc >= $0020) and (cc < $d800) or (cc >= $e000) and (cc < $110000) then begin
if cc >= $010000 then begin
dec(cc, $010000);
s := wchar($d800 + (cc shr 10)) + wchar($dc00 + (cc and $3ff));
end else begin
s := wchar(cc);
end;
result := result + ', ''' + toUTF8String(s) + '''';
end;
result := result + ')';
end;
else
result := '';
end;
end;
function DefaultRepresenter.getFloatRepresentation(value: float): AnsiString;
begin
result := toDecString(toReal(value)) + ' ($' + toHexString(zeroExtend(floatToIntBits(value)), 8) + ')';
end;
function DefaultRepresenter.getDoubleRepresentation(value: double): AnsiString;
begin
result := toDecString(toReal(value)) + ' ($' + toHexString(doubleToLongBits(value), 16) + ')';
end;
function DefaultRepresenter.getRealRepresentation(value: real): AnsiString;
begin
result := toDecString(value) + ' ($' + toHexString(extractExponentAndSign(value), 4) + toHexString(extractSignificand(value), 16) + ')';
end;
function DefaultRepresenter.getRealRepresentation(value: real; sourceType: int): AnsiString;
var
s: AnsiString;
begin
case sourceType of
1: s := 'F';
2: s := 'D';
else
s := '';
end;
result := toDecString(value) + s + ' ($' + toHexString(extractExponentAndSign(value), 4) + toHexString(extractSignificand(value), 16) + ')';
end;
function DefaultRepresenter.getObjectRepresentation(value: int): AnsiString;
begin
if value <> 0 then begin
result := '$' + toHexString(zeroExtend(value), 8);
end else begin
result := 'null';
end;
end;
function DefaultRepresenter.getHexRepresentation(value: int): AnsiString;
begin
result := '$' + toHexString(zeroExtend(value), 1);
end;
function DefaultRepresenter.getTypeRepresentation(const rawRepresentation: AnsiString): AnsiString;
var
d: int;
i: int;
begin
i := length(rawRepresentation);
if i > 0 then begin
case rawRepresentation[1] of
SIGNATURE_VOID: begin
result := '';
end;
SIGNATURE_BOOLEAN: begin
result := 'boolean';
end;
SIGNATURE_BYTE: begin
result := 'byte';
end;
SIGNATURE_SHORT: begin
result := 'short';
end;
SIGNATURE_INT: begin
result := 'int';
end;
SIGNATURE_LONG: begin
result := 'long';
end;
SIGNATURE_WCHAR: begin
result := 'wchar';
end;
SIGNATURE_ICHAR: begin
result := 'ichar';
end;
SIGNATURE_FLOAT: begin
result := 'float';
end;
SIGNATURE_DOUBLE: begin
result := 'double';
end;
SIGNATURE_REAL: begin
result := 'real';
end;
SIGNATURE_OBJECT: begin
if i = 1 then begin
result := 'object';
exit;
end;
if rawRepresentation[i] = SIGNATURE_SUFFIX then begin
result := copy(rawRepresentation, 2, i - 2);
end else begin
result := copy(rawRepresentation, 2, i - 1);
end;
for i := 1 to length(result) do begin
if result[i] in ['/', '|', '\'] then begin
result[i] := '.';
end;
end;
end;
SIGNATURE_CLASS: begin
result := 'class of ' + getTypeRepresentation(SIGNATURE_OBJECT + copy(rawRepresentation, 2, i - 1));
end;
SIGNATURE_ARRAY: begin
d := 1;
while (i > d) and (rawRepresentation[d + 1] = SIGNATURE_ARRAY) do begin
inc(d);
end;
result := getTypeRepresentation(copy(rawRepresentation, d + 1, i - d));
for i := 1 to d do begin
result := result + '[]';
end;
end;
else
result := '???';
end;
end else begin
result := '???';
end;
end;
{%endregion}
{%region DebugInfo }
constructor DebugInfo.create(address: int; const info: AnsiString);
begin
inherited create();
self.address := address;
self.info := info;
end;
function DebugInfo.getAddress(): int;
begin
result := address;
end;
function DebugInfo.getInfo(): AnsiString;
begin
result := info;
end;
{%endregion}
{%region ClassDebugInfo }
constructor ClassDebugInfo.create(address: int; const info: AnsiString);
begin
inherited create(address, info);
end;
destructor ClassDebugInfo.destroy;
var
a: DebugInfo_Array1d;
i: int;
begin
a := fields;
for i := count - 1 downto 0 do begin
a[i].free();
end;
inherited destroy;
end;
function ClassDebugInfo.getParentsCount(): int;
var
d: ClassDebugInfo;
begin
result := 0;
d := parent;
while (d <> nil) and (d <> self) do begin
inc(result);
d := d.parent;
end;
end;
function ClassDebugInfo.getFieldsCount(): int;
begin
result := count;
end;
function ClassDebugInfo.getField(index: int): DebugInfo;
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(index);
end;
result := fields[index];
end;
function ClassDebugInfo.getParent(): ClassDebugInfo;
begin
result := parent;
end;
procedure ClassDebugInfo.addField(offset: int; const info: AnsiString);
var
a: DebugInfo_Array1d;
l: int;
begin
a := fields;
l := count;
if l = length(a) then begin
a := DebugInfo_Array1d_create(l + 16);
arraycopy(fields, 0, a, 0, l);
fields := a;
end;
a[l] := DebugInfo.create(offset, info);
count := l + 1;
end;
procedure ClassDebugInfo.setParent(parent: ClassDebugInfo);
begin
if self.parent = nil then begin
self.parent := parent;
end;
end;
{%endregion}
{%region DisassemblerObject }
constructor DisassemblerObject.create(TDisassemblerForm_self: TDisassemblerForm);
begin
inherited create();
self.TDisassemblerForm_self := TDisassemblerForm_self;
end;
{%endregion}
{%region GUIElement }
constructor GUIElement.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self);
self.box := box;
self.scroll := scroll;
end;
procedure GUIElement.pointerPressed(x, y: int; auxButton: boolean);
begin
end;
procedure GUIElement.pointerReleased(x, y: int; auxButton: boolean);
begin
end;
function GUIElement.getLinesCount(): int;
begin
result := -1;
end;
procedure GUIElement.repaint();
begin
TDisassemblerForm_self.paintGUIElement(self);
end;
{%endregion}
{%region ClickableGUIElement }
constructor ClickableGUIElement.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self, box, scroll);
clickedLine := -1;
end;
procedure ClickableGUIElement.paint(canvas: TCanvas; width, height, scrollPosition: int);
var
i: int;
j: int;
b: int;
h: int;
m: int;
highlighted: boolean;
begin
h := abs(canvas.font.height);
if h = 0 then begin
exit;
end;
self.paintedFromLine := scrollPosition;
self.lineHeight := h;
b := scrollPosition + (height div h);
if (height mod h) > 0 then begin
inc(b);
end;
m := getLinesCount();
if b > m then begin
b := m;
end;
j := 0;
for i := scrollPosition to b - 1 do begin
highlighted := clickedLine = i;
if highlighted then begin
canvas.brush.style := bsSolid;
canvas.brush.color := clHighlight;
canvas.fillRect(0, j, width, j + h + 2);
end;
paintLine(canvas, 0, j, width, h, i, highlighted);
inc(j, h);
end;
end;
procedure ClickableGUIElement.pointerPressed(x, y: int; auxButton: boolean);
var
h: int;
begin
h := lineHeight;
if h = 0 then begin
exit;
end;
clickedLine := paintedFromLine + (y div h);
if clickedLine < getLinesCount() then begin
repaint();
end;
end;
procedure ClickableGUIElement.pointerReleased(x, y: int; auxButton: boolean);
var
h: int;
i: int;
begin
h := lineHeight;
if h = 0 then begin
exit;
end;
try
i := clickedLine;
if (i < getLinesCount()) and (paintedFromLine + (y div h) = i) then begin
lineClicked(i, auxButton);
end;
finally
if clickedLine >= 0 then begin
clickedLine := -1;
repaint();
end;
end;
end;
procedure ClickableGUIElement.lineClicked(lineIndex: int; auxButton: boolean);
begin
end;
{%endregion}
{%region FieldInfo }
constructor FieldInfo.create();
begin
inherited create();
end;
{%endregion}
{%region DebugInspectorHistoryElement }
constructor DebugInspectorHistoryElement.create(TDisassemblerForm_self: TDisassemblerForm; const dataType: AnsiString; address: int);
begin
inherited create(TDisassemblerForm_self);
self.dataType := dataType;
self.address := address;
end;
function DebugInspectorHistoryElement.getTypeRepresentation(): AnsiString;
var
d: ClassDebugInfo;
r: Representer;
s: AnsiString;
begin
r := TDisassemblerForm.DATA_REPRESENTER;
s := dataType;
if (length(s) > 0) and (s[1] in [SIGNATURE_OBJECT, SIGNATURE_CLASS, SIGNATURE_ARRAY]) then begin
d := getClassInfo();
if d <> nil then begin
result := r.getTypeRepresentation(d.getInfo());
exit;
end;
result := r.getTypeRepresentation(SIGNATURE_OBJECT);
exit;
end;
result := r.getTypeRepresentation(s);
end;
function DebugInspectorHistoryElement.getValueRepresentation(): AnsiString;
begin
result := TDisassemblerForm_self.getValueRepresentation(address, dataType);
end;
function DebugInspectorHistoryElement.getFieldInfo(index: int; info: FieldInfo): boolean;
var
f: TDisassemblerForm;
r: Representer;
clsinfo: ClassDebugInfo;
current: ClassDebugInfo;
fieldInfo: DebugInfo;
intArray: PIntArray;
typeInfo: AnsiString;
len: int;
objValue: int;
arrayLength: int;
arrayOffset: int;
fields: int;
fieldsCount: int;
fieldIndex: int;
colonPos: int;
begin
result := false;
clsinfo := getClassInfo();
if clsinfo = nil then begin
exit;
end;
f := TDisassemblerForm_self;
intArray := PIntArray(f.processor.getMemory(address, sizeof(int)));
if intArray = nil then begin
exit;
end;
objValue := intArray[0];
if objValue = 0 then begin
exit;
end;
r := TDisassemblerForm.DATA_REPRESENTER;
current := clsinfo;
fields := 0;
fieldIndex := index - fields;
repeat
if current <> clsinfo then begin
if fieldIndex = 0 then begin
info.fieldAddress := 0;
info.fieldDataType := '';
info.fieldRepresentation := 'Унаследовано от ' + r.getTypeRepresentation(current.getInfo());
info.valueRepresentation := '';
info.color := f.colorInherited;
result := true;
exit;
end;
inc(fields);
fieldIndex := index - fields;
end;
typeInfo := current.getInfo();
len := length(typeInfo);
if (len > 0) and (typeInfo[1] = SIGNATURE_ARRAY) then begin
intArray := PIntArray(f.processor.getMemory(objValue + 8, 2 * sizeof(int)));
if intArray = nil then begin
exit;
end;
arrayLength := intArray[0];
arrayOffset := intArray[1];
if (fieldIndex >= 0) and (fieldIndex < arrayLength + 1) then begin
if fieldIndex > 0 then begin
dec(fieldIndex);
dec(len);
typeInfo := copy(typeInfo, 2, len);
info.fieldAddress := objValue + fieldIndex * typeSize(typeInfo) + arrayOffset + 16;
info.fieldDataType := typeInfo;
info.fieldRepresentation := '[' + r.getLongRepresentation(fieldIndex, DATA_TYPE_INT) + ']: ' + r.getTypeRepresentation(typeInfo);
info.valueRepresentation := f.getValueRepresentation(info.fieldAddress, typeInfo);
if (len > 0) and (typeInfo[1] in [SIGNATURE_OBJECT, SIGNATURE_CLASS, SIGNATURE_ARRAY]) then begin
info.color := f.colorObjectData;
end else begin
info.color := f.colorNormalData;
end;
end else begin
info.fieldAddress := objValue + 8;
info.fieldDataType := SIGNATURE_INT;
info.fieldRepresentation := f.getFieldRepresentation('длина:' + SIGNATURE_INT);
info.valueRepresentation := f.getValueRepresentation(info.fieldAddress, SIGNATURE_INT);
info.color := f.colorNormalData;
end;
result := true;
exit;
end;
inc(fields, arrayLength + 1);
fieldIndex := index - fields;
end else begin
fieldsCount := current.getFieldsCount();
if (fieldIndex >= 0) and (fieldIndex < fieldsCount) then begin
fieldInfo := current.getField(fieldIndex);
typeInfo := fieldInfo.getInfo();
info.fieldRepresentation := TDisassemblerForm.getFieldRepresentation(typeInfo);
colonPos := pos(':', typeInfo);
typeInfo := trim(copy(typeInfo, colonPos + 1, length(typeInfo) - colonPos));
info.fieldAddress := objValue + fieldInfo.getAddress();
info.fieldDataType := typeInfo;
info.valueRepresentation := f.getValueRepresentation(info.fieldAddress, typeInfo);
len := length(typeInfo);
if (len > 0) and (typeInfo[1] in [SIGNATURE_OBJECT, SIGNATURE_CLASS, SIGNATURE_ARRAY]) then begin
info.color := f.colorObjectData;
end else begin
info.color := f.colorNormalData;
end;
result := true;
exit;
end;
inc(fields, fieldsCount);
fieldIndex := index - fields;
end;
current := current.getParent();
until (current = nil) or (current = clsinfo);
end;
function DebugInspectorHistoryElement.getFieldsCount(): int;
var
p: MalikProcessor;
clsinfo: ClassDebugInfo;
current: ClassDebugInfo;
intArray: PIntArray;
typeInfo: AnsiString;
objValue: int;
arrayLength: int;
begin
result := 0;
clsinfo := getClassInfo();
if clsinfo = nil then begin
exit;
end;
p := TDisassemblerForm_self.processor;
intArray := PIntArray(p.getMemory(address, sizeof(int)));
if intArray = nil then begin
exit;
end;
objValue := intArray[0];
if objValue = 0 then begin
exit;
end;
current := clsinfo;
repeat
if current <> clsinfo then begin
inc(result);
end;
typeInfo := current.getInfo();
if (length(typeInfo) > 0) and (typeInfo[1] = SIGNATURE_ARRAY) then begin
intArray := PIntArray(p.getMemory(objValue + 8, sizeof(int)));
if intArray = nil then begin
exit;
end;
arrayLength := intArray[0];
inc(result, arrayLength + 1);
end else begin
inc(result, current.getFieldsCount());
end;
current := current.getParent();
until (current = nil) or (current = clsinfo);
end;
function DebugInspectorHistoryElement.getAddress(): int;
begin
result := address;
end;
function DebugInspectorHistoryElement.getClassInfo(): ClassDebugInfo;
var
f: TDisassemblerForm;
p: MalikProcessor;
typeInfo: AnsiString;
intArray: PIntArray;
objValue: int;
clsValue: int;
begin
result := nil;
typeInfo := dataType;
if (length(typeInfo) <= 0) or (not (typeInfo[1] in [SIGNATURE_OBJECT, SIGNATURE_CLASS, SIGNATURE_ARRAY])) then begin
exit;
end;
f := TDisassemblerForm_self;
p := f.processor;
intArray := PIntArray(p.getMemory(address, sizeof(int)));
if intArray = nil then begin
exit;
end;
objValue := intArray[0];
if objValue = 0 then begin
exit;
end;
intArray := PIntArray(p.getMemory(objValue + 4, sizeof(int)));
if intArray = nil then begin
exit;
end;
clsValue := intArray[0];
result := f.getClassInfo(clsValue, f.classesInfo);
end;
function DebugInspectorHistoryElement.isObjectType(): boolean;
var
typeInfo: AnsiString;
begin
typeInfo := dataType;
result := (length(typeInfo) > 0) and (typeInfo[1] in [SIGNATURE_OBJECT, SIGNATURE_CLASS, SIGNATURE_ARRAY]);
end;
{%endregion}
{%region DebugInspectorHistory }
constructor DebugInspectorHistory.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar; const dataType: AnsiString; address: int);
var
item: TMenuItem;
begin
inherited create(TDisassemblerForm_self, box, scroll);
menu := TPopupMenu.create(TDisassemblerForm_self);
field := FieldInfo.create();
history := DebugInspectorHistoryElement_Array1d_create(15);
history[0] := DebugInspectorHistoryElement.create(TDisassemblerForm_self, dataType, address);
count := 1;
item := TMenuItem.create(TDisassemblerForm_self);
menu.items.add(item);
item.caption := getElementRepresentation(0);
item.autoCheck := true;
item.groupIndex := 1;
item.radioItem := true;
item.tag := 0;
item.checked := true;
item.onClick := TDisassemblerForm_self.debugInspectorHistoryMenuClickItem;
end;
destructor DebugInspectorHistory.destroy;
var
i: int;
h: DebugInspectorHistoryElement_Array1d;
m: TMenuItem;
begin
h := history;
m := menu.items;
for i := count - 1 downto 0 do begin
h[i].free();
m.items[i].free();
end;
menu.free();
field.free();
inherited destroy;
end;
procedure DebugInspectorHistory.insert(const dataType: AnsiString; address: int);
var
f: TDisassemblerForm;
item: TMenuItem;
m: TMenuItem;
h: DebugInspectorHistoryElement_Array1d;
i: int;
l: int;
begin
h := history;
l := current + 1;
m := menu.items;
for i := count - 1 downto l do begin
h[i].free();
h[i] := nil;
m.items[i].free();
end;
if l = length(h) then begin
h := DebugInspectorHistoryElement_Array1d_create((l shl 1) + 1);
arraycopy(history, 0, h, 0, l);
history := h;
end;
f := TDisassemblerForm_self;
h[l] := DebugInspectorHistoryElement.create(f, dataType, address);
item := TMenuItem.create(f);
m.add(item);
item.caption := getElementRepresentation(l);
item.autoCheck := true;
item.groupIndex := 1;
item.radioItem := true;
item.tag := l;
item.checked := true;
item.onClick := f.debugInspectorHistoryMenuClickItem;
count := l + 1;
gotoElement(l);
end;
procedure DebugInspectorHistory.paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean);
var
x: int;
w: int;
fld: FieldInfo;
field: UnicodeString;
value: AnsiString;
begin
fld := self.field;
if not history[current].getFieldInfo(lineIndex, fld) then begin
exit;
end;
canvas.brush.style := bsClear;
canvas.font.style := [];
if length(fld.valueRepresentation) = 0 then begin
canvas.font.style := [fsBold];
x := 0;
end else begin
x := 32;
end;
if highlighted then begin
canvas.font.color := clHighlightText;
end else begin
canvas.font.color := fld.color;
end;
field := toUTF16String(fld.fieldRepresentation);
value := fld.valueRepresentation;
w := width - canvas.textWidth(value) - x;
while (length(field) > 2) and (canvas.textWidth(toUTF8String(field)) > w) do begin
field := copy(field, 1, length(field) - 2) + #$2026;
{ $2026 – код символа многоточия («…») }
end;
canvas.textOut(left + x, top, toUTF8String(field));
canvas.textOut(left + x + w, top, value);
end;
procedure DebugInspectorHistory.paint(canvas: TCanvas; width, height, scrollPosition: int);
var
f: TDisassemblerForm;
e: DebugInspectorHistoryElement;
r: Representer;
i: int;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
e := history[current];
r := TDisassemblerForm.DATA_REPRESENTER;
f.debugInspectorBackButton.enabled := current > 0;
f.debugInspectorNextButton.enabled := current < count - 1;
f.debugInspectorAddress.caption := r.getHexRepresentation(e.getAddress());
f.debugInspectorClass.caption := e.getTypeRepresentation();
f.debugInspectorValue.caption := e.getValueRepresentation();
if e.isObjectType() then begin
f.debugInspectorValue.font.color := f.colorObjectData;
end else begin
f.debugInspectorValue.font.color := f.colorNormalData;
end;
for i := 0 to count - 1 do begin
menu.items.items[i].caption := getElementRepresentation(i);
end;
inherited paint(canvas, width, height, scrollPosition);
end;
procedure DebugInspectorHistory.lineClicked(lineIndex: int; auxButton: boolean);
var
f: TDisassemblerForm;
fld: FieldInfo;
begin
f := TDisassemblerForm_self;
fld := field;
if f.owner.isNowDebugging() and history[current].getFieldInfo(lineIndex, fld) then begin
if auxButton then begin
f.addDebugInspectorElement(fld.fieldRepresentation, fld.fieldDataType, fld.fieldAddress);
end else begin
insert(fld.fieldDataType, fld.fieldAddress);
end;
end;
end;
function DebugInspectorHistory.getLinesCount(): int;
begin
result := history[current].getFieldsCount();
end;
procedure DebugInspectorHistory.gotoPrevElement();
begin
gotoElement(current - 1);
end;
procedure DebugInspectorHistory.gotoNextElement();
begin
gotoElement(current + 1);
end;
procedure DebugInspectorHistory.gotoElement(index: int);
var
f: TDisassemblerForm;
begin
f := TDisassemblerForm_self;
if index < 0 then begin
index := 0;
end;
if index >= count then begin
index := count - 1;
end;
history[current].position := f.debugInspectorScrollbar.position;
current := index;
menu.items.items[index].checked := true;
repaint();
if f.debugInspectorScrollbar.enabled then begin
f.debugInspectorScrollbar.position := history[index].position;
end;
end;
function DebugInspectorHistory.getElementRepresentation(index: int): AnsiString;
var
r: Representer;
e: DebugInspectorHistoryElement;
begin
r := TDisassemblerForm.DATA_REPRESENTER;
e := history[index];
result := r.getHexRepresentation(e.getAddress()) + ' : ' + e.getTypeRepresentation();
end;
function DebugInspectorHistory.getCurrentIndex(): int;
begin
result := current;
end;
function DebugInspectorHistory.getCount(): int;
begin
result := count;
end;
function DebugInspectorHistory.getMenu(): TPopupMenu;
begin
result := menu;
end;
{%endregion}
{%region TDisassemblerForm }
class procedure TDisassemblerForm.clinit();
begin
INSTRUCTIONS_NAMES := toStringArray1d([
'nop',
'load byte as long ',
'load short as long ',
'load int as long ',
'load long ',
'load float ',
'load double ',
'load real ',
'load except ',
'load byte as int ',
'load short as int ',
'load int ',
'load wchar ',
'load float as double ',
'load float as real ',
'load double as real ',
'pop',
'pop ',
'dup',
'dup ',
'dup x 1',
'dup x ',
'swap',
'dup ',
'popdw',
'popdw2',
'dupdw',
'dupdw2',
'dupdw x 1',
'dupdw2 x 1',
'dupdw x 2',
'dupdw2 x 2',
'load byte as long ',
'load short as long ',
'load int as long ',
'load long ',
'load float ',
'load double ',
'load real ',
'load object ',
'load byte as int ',
'load short as int ',
'load int ',
'load wchar ',
'load float as double ',
'load float as real ',
'load double as real ',
'load null',
'store long as byte ',
'store long as short ',
'store long as int ',
'store long ',
'store float ',
'store double ',
'store real ',
'store object ',
'store int as byte ',
'store int as short ',
'store int ',
'store wchar ',
'store double as float ',
'store real as float ',
'store real as double ',
'breakpoint',
'load ',
'load ',
'load int ',
'load long ',
'load float ',
'load double ',
'load real ',
'load object ',
'store ',
'store ',
'store int ',
'store long ',
'store float ',
'store double ',
'store real ',
'store object ',
'add int',
'add long',
'add float',
'add double',
'sub int',
'sub long',
'sub float',
'sub double',
'mul int',
'mul long',
'mul float',
'mul double',
'div int',
'div long',
'div float',
'div double',
'or int',
'or long',
'and int',
'and long',
'xor int',
'xor long',
'sar int',
'sar long',
'sal int',
'sal long',
'shr int',
'shr long',
'rem int',
'rem long',
'rem float',
'rem double',
'add real',
'sub real',
'mul real',
'div real',
'sar int ',
'sal int ',
'shr int ',
'rem real',
'sar long ',
'sal long ',
'shr long ',
'neg real',
'neg int',
'neg long',
'neg float',
'neg double',
'cast int to long',
'cast int to float',
'cast int to double',
'cast int to real',
'cast long to int',
'cast long to float',
'cast long to double',
'cast long to real',
'cast float to int',
'cast float to long',
'cast float to double',
'cast float to real',
'cast double to int',
'cast double to long',
'cast double to float',
'cast double to real',
'cast real to int',
'cast real to long',
'cast real to float',
'cast real to double',
'cast int to byte',
'cast int to short',
'cast int to wchar',
'cast int to object',
'cast long to byte as int',
'cast long to short as int',
'cast long to wchar as int',
'cast object to int',
'cast long to byte as long',
'cast long to short as long',
'cast long to wchar as long',
'cast long to int as long',
'eq object null ?',
'ne object null ?',
'gt int 0 ?',
'le int 0 ?',
'eq int 0 ?',
'ne int 0 ?',
'lt int 0 ?',
'ge int 0 ?',
'eq object ?',
'ne object ?',
'gt int ?',
'le int ?',
'eq int ?',
'ne int ?',
'lt int ?',
'ge int ?',
'jmp ',
'jmp ',
'jmp ',
'jmp ',
'call ',
'call ',
'call ',
'call ',
'jmp int',
'call int',
'iret1',
'iret2',
'ret',
'ret ',
'retval',
'retval ',
'getfield byte as long ',
'getfield short as long ',
'getfield int as long ',
'getfield long ',
'getfield float ',
'getfield double ',
'getfield real ',
'getfield object ',
'getfield byte as int ',
'getfield short as int ',
'getfield int ',
'getfield wchar ',
'getfield float as double ',
'getfield float as real ',
'getfield double as real ',
'getclass',
'setfield long as byte ',
'setfield long as short ',
'setfield long as int ',
'setfield long ',
'setfield float ',
'setfield double ',
'setfield real ',
'setfield object ',
'setfield int as byte ',
'setfield int as short ',
'setfield int ',
'setfield wchar ',
'setfield double as float ',
'setfield real as float ',
'setfield real as double ',
'setclass',
'load ',
'load ',
'load int ',
'load long ',
'load float ',
'load double ',
'load real ',
'load object ',
'store ',
'store ',
'store int ',
'store long ',
'store float ',
'store double ',
'store real ',
'store object ',
'getrefcount',
'cmp long',
'cmpl float',
'cmpg float',
'cmpl double',
'cmpg double',
'cmpl real',
'cmpg real',
'setrefcount',
'syscall ',
'interrupt object ',
'enter ',
'leave',
'leaveval',
'currthrd int',
'',
'getarraycell byte as long',
'getarraycell short as long',
'getarraycell int as long',
'getarraycell long',
'getarraycell float',
'getarraycell double',
'getarraycell real',
'getarraycell object',
'getarraycell byte as int',
'getarraycell short as int',
'getarraycell int',
'getarraycell wchar',
'getarraycell float as double',
'getarraycell float as real',
'getarraycell double as real',
'getarraylength',
'setarraycell long as byte',
'setarraycell long as short',
'setarraycell long as int',
'setarraycell long',
'setarraycell float',
'setarraycell double',
'setarraycell real',
'setarraycell object',
'setarraycell int as byte',
'setarraycell int as short',
'setarraycell int',
'setarraycell wchar',
'setarraycell double as float',
'setarraycell real as float',
'setarraycell real as double',
'setarraylength',
'je object null ',
'jne object null ',
'jg int 0 ',
'jle int 0 ',
'je int 0 ',
'jne int 0 ',
'jl int 0 ',
'jge int 0 ',
'je object ',
'jne object ',
'jg int ',
'jle int ',
'je int ',
'jne int ',
'jl int ',
'jge int ',
'je object null ',
'jne object null ',
'jg int 0 ',
'jle int 0 ',
'je int 0 ',
'jne int 0 ',
'jl int 0 ',
'jge int 0 ',
'je object ',
'jne object ',
'jg int ',
'jle int ',
'je int ',
'jne int ',
'jl int ',
'jge int ',
'je object null ',
'jne object null ',
'jg int 0 ',
'jle int 0 ',
'je int 0 ',
'jne int 0 ',
'jl int 0 ',
'jge int 0 ',
'je object ',
'jne object ',
'jg int ',
'jle int ',
'je int ',
'jne int ',
'jl int ',
'jge int ',
'interrupt ',
'interrupt int ',
'interrupt long ',
'interrupt float ',
'interrupt double ',
'interrupt real ',
'check arraybound',
'runexcept object',
'tableswitch byte ',
'tableswitch short ',
'tableswitch int ',
'tableswitch long ',
'lookupswitch byte ',
'lookupswitch short ',
'lookupswitch int ',
'lookupswitch long ',
'int float',
'frac float',
'sqrt float',
'atan float',
'sin float',
'cos float',
'pow2 float',
'log2 float',
'int double',
'frac double',
'sqrt double',
'atan double',
'sin double',
'cos double',
'pow2 double',
'log2 double',
'int real',
'frac real',
'sqrt real',
'atan real',
'sin real',
'cos real',
'pow2 real',
'log2 real',
'floor float',
'ceil float',
'floor double',
'ceil double',
'floor real',
'ceil real',
'round double',
'round real',
'add int ',
'add long ',
'add float ',
'add double ',
'sub int ',
'sub long ',
'sub float ',
'sub double ',
'mul int ',
'mul long ',
'mul float ',
'mul double ',
'div int ',
'div long ',
'div float ',
'div double ',
'or int ',
'or long ',
'and int ',
'and long ',
'xor int ',
'xor long ',
'sar int ',
'sar long ',
'sal int ',
'sal long ',
'shr int ',
'shr long ',
'rem int ',
'rem long ',
'rem float ',
'rem double ',
'add real ',
'sub real ',
'mul real ',
'div real ',
'sar int ',
'sal int ',
'shr int ',
'rem real ',
'sar long ',
'sal long ',
'shr long ',
'neg real ',
'neg int ',
'neg long ',
'neg float ',
'neg double ',
'roundtn real to integer',
'roundtn real to double',
'roundtn real to float',
'roundtn double to float',
'roundtni real to integer',
'roundtni real to double',
'roundtni real to float',
'roundtni double to float',
'roundtpi real to integer',
'roundtpi real to double',
'roundtpi real to float',
'roundtpi double to float',
'roundtz real to integer',
'roundtz real to double',
'roundtz real to float',
'roundtz double to float',
'add int ',
'add long ',
'add float ',
'add double ',
'sub int ',
'sub long ',
'sub float ',
'sub double ',
'mul int ',
'mul long ',
'mul float ',
'mul double ',
'div int ',
'div long ',
'div float ',
'div double ',
'or int ',
'or long ',
'and int ',
'and long ',
'xor int ',
'xor long ',
'sar int ',
'sar long ',
'sal int ',
'sal long ',
'shr int ',
'shr long ',
'rem int ',
'rem long ',
'rem float ',
'rem double ',
'add real ',
'sub real ',
'mul real ',
'div real ',
'sar int ',
'sal int ',
'shr int ',
'rem real ',
'sar long ',
'sal long ',
'shr long ',
'neg real ',
'neg int ',
'neg long ',
'neg float ',
'neg double ',
'inc int ',
'inc int ',
'inc int',
'mkreal real',
'inc long ',
'inc long ',
'inc long',
'mkreal float',
'dec int ',
'dec int ',
'dec int',
'mkreal double',
'dec long ',
'dec long ',
'dec long',
'',
'arraycopyf byte',
'arraycopyf short',
'arraycopyf int',
'arraycopyf long',
'arraycopyf float',
'arraycopyf double',
'arraycopyf real',
'arraycopyf object',
'arraycopyb byte',
'arraycopyb short',
'arraycopyb int',
'arraycopyb long',
'arraycopyb float',
'arraycopyb double',
'arraycopyb real',
'arraycopyb object',
'arrayfindf byte',
'arrayfindf short',
'arrayfindf int',
'arrayfindf long',
'arrayfindf float',
'arrayfindf double',
'arrayfindf real',
'arrayfindf object',
'arrayfindb byte',
'arrayfindb short',
'arrayfindb int',
'arrayfindb long',
'arrayfindb float',
'arrayfindb double',
'arrayfindb real',
'arrayfindb object',
'arrayfill byte',
'arrayfill short',
'arrayfill int',
'arrayfill long',
'arrayfill float',
'arrayfill double',
'arrayfill real',
'arrayfill object',
'findfreef',
'findfreeb',
'findzerof',
'findzerob',
'getobjectrefs',
'getarrayrefs',
'blockfindf',
'blockfindb',
'check object null ',
'check object null ',
'jmponce '
]);
DATA_REPRESENTER := DefaultRepresenter.create();
end;
class procedure TDisassemblerForm.cldone();
begin
DATA_REPRESENTER := nil;
INSTRUCTIONS_NAMES := nil;
end;
class function TDisassemblerForm.getFieldRepresentation(const fieldDebugInfoLine: AnsiString): AnsiString;
var
colonPos: int;
fieldName: AnsiString;
typeName: AnsiString;
begin
colonPos := pos(':', fieldDebugInfoLine);
if colonPos > 0 then begin
fieldName := trim(copy(fieldDebugInfoLine, 1, colonPos - 1));
typeName := trim(copy(fieldDebugInfoLine, colonPos + 1, length(fieldDebugInfoLine) - colonPos));
result := fieldName + ': ' + DATA_REPRESENTER.getTypeRepresentation(typeName);
end else begin
result := fieldDebugInfoLine;
end;
end;
class function TDisassemblerForm.getVariableRepresentation(const variableDebugInfoLine: AnsiString): AnsiString;
var
periodPos: int;
colonPos: int;
className: AnsiString;
varName: AnsiString;
typeName: AnsiString;
begin
periodPos := pos('.', variableDebugInfoLine);
colonPos := pos(':', variableDebugInfoLine);
if (periodPos > 0) and (colonPos > periodPos) then begin
className := trim(copy(variableDebugInfoLine, 1, periodPos - 1));
varName := trim(copy(variableDebugInfoLine, periodPos + 1, colonPos - periodPos - 1));
typeName := trim(copy(variableDebugInfoLine, colonPos + 1, length(variableDebugInfoLine) - colonPos));
result := DATA_REPRESENTER.getTypeRepresentation(SIGNATURE_OBJECT + className + SIGNATURE_SUFFIX) + ' . ' + varName + ': ' + DATA_REPRESENTER.getTypeRepresentation(typeName);
end else begin
result := getFieldRepresentation(variableDebugInfoLine);
end;
end;
class function TDisassemblerForm.getFunctionRepresentation(const functionDebugInfoLine: AnsiString): AnsiString;
var
className: AnsiString;
funcName: AnsiString;
arguments: AnsiString_Array1d;
count: int;
periodPos: int;
lparenPos: int;
rparenPos: int;
i: int;
j: int;
r: Representer;
procedure addArgument(const arg: AnsiString);
var
a: AnsiString_Array1d;
c: int;
begin
a := arguments;
c := count;
if c = length(a) then begin
a := String_Array1d_create((c shl 1) + 1);
arraycopy(arguments, 0, a, 0, c);
arguments := a;
end;
a[c] := arg;
count := c + 1;
end;
begin
periodPos := pos('.', functionDebugInfoLine);
lparenPos := pos('(', functionDebugInfoLine);
rparenPos := pos(')', functionDebugInfoLine);
if (periodPos > 0) and (lparenPos > periodPos) and (rparenPos > lparenPos) then begin
r := DATA_REPRESENTER;
className := r.getTypeRepresentation(SIGNATURE_OBJECT + copy(functionDebugInfoLine, 1, periodPos - 1) + SIGNATURE_SUFFIX);
funcName := copy(functionDebugInfoLine, periodPos + 1, lparenPos - periodPos - 1);
count := 0;
i := lparenPos + 1;
while i < rparenPos do begin
case functionDebugInfoLine[i] of
SIGNATURE_BOOLEAN, SIGNATURE_WCHAR, SIGNATURE_ICHAR, SIGNATURE_FLOAT, SIGNATURE_DOUBLE,
SIGNATURE_REAL, SIGNATURE_BYTE, SIGNATURE_SHORT, SIGNATURE_INT, SIGNATURE_LONG: begin
addArgument(r.getTypeRepresentation(functionDebugInfoLine[i]));
inc(i);
end;
SIGNATURE_OBJECT, SIGNATURE_CLASS: begin
j := i + 1;
while (j < rparenPos) and (functionDebugInfoLine[j] <> SIGNATURE_SUFFIX) do begin
inc(j);
end;
if j <> rparenPos then begin
addArgument(r.getTypeRepresentation(copy(functionDebugInfoLine, i, j - i + 1)));
inc(j);
end else begin
addArgument(r.getTypeRepresentation(copy(functionDebugInfoLine, i, j - i) + SIGNATURE_SUFFIX));
end;
i := j;
end;
SIGNATURE_ARRAY: begin
j := i + 1;
while (j < rparenPos) and (functionDebugInfoLine[j] = SIGNATURE_ARRAY) do begin
inc(j);
end;
case functionDebugInfoLine[j] of
SIGNATURE_BOOLEAN, SIGNATURE_WCHAR, SIGNATURE_ICHAR, SIGNATURE_FLOAT, SIGNATURE_DOUBLE,
SIGNATURE_REAL, SIGNATURE_BYTE, SIGNATURE_SHORT, SIGNATURE_INT, SIGNATURE_LONG: begin
inc(j);
end;
SIGNATURE_OBJECT: begin
inc(j);
while (j < rparenPos) and (functionDebugInfoLine[j] <> SIGNATURE_SUFFIX) do begin
inc(j);
end;
if j <> rparenPos then begin
inc(j);
end;
end;
else
i := j;
continue;
end;
addArgument(r.getTypeRepresentation(copy(functionDebugInfoLine, i, j - i)));
i := j;
end;
else
inc(i);
end;
end;
result := className + ' . ' + funcName + '(';
for i := 0 to count - 1 do begin
result := result + arguments[i];
if i < count - 1 then begin
result := result + ', ';
end;
end;
result := result + ')';
j := length(functionDebugInfoLine);
if (j > rparenPos) and (functionDebugInfoLine[rparenPos + 1] <> SIGNATURE_VOID) then begin
result := result + ': ' + r.getTypeRepresentation(copy(functionDebugInfoLine, rparenPos + 1, j - rparenPos));
end;
end else begin
result := functionDebugInfoLine;
end;
end;
constructor TDisassemblerForm.create(theOwner: TComponent);
var
mainwnd: MainWindowInterface;
begin
inherited create(theOwner);
theOwner.getInterface(EMULATION_WINDOW_INTERFACE_GUID, owner);
image := TBitmap.create();
processor := owner.getMalikProcessor();
currentContext := MalikDebugContext.create();
guiDebugInspector := DebugInspectorHistory_Array1d_create(16);
mainwnd := owner.getMainWindow();
colorEmptyData := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_EMPTY_DATA, ''), DEFAULT_DEBUGGER_COLOR_EMPTY_DATA)) shr 8;
colorNormalData := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_NORMAL_DATA, ''), DEFAULT_DEBUGGER_COLOR_NORMAL_DATA)) shr 8;
colorObjectData := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_OBJECT_DATA, ''), DEFAULT_DEBUGGER_COLOR_OBJECT_DATA)) shr 8;
colorExceptData := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_EXCEPT_DATA, ''), DEFAULT_DEBUGGER_COLOR_EXCEPT_DATA)) shr 8;
colorOldEBPData := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_OLDEBP_DATA, ''), DEFAULT_DEBUGGER_COLOR_OLDEBP_DATA)) shr 8;
colorReturnData := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_RETURN_DATA, ''), DEFAULT_DEBUGGER_COLOR_RETURN_DATA)) shr 8;
colorIReturnData := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_IRETURN_DATA, ''), DEFAULT_DEBUGGER_COLOR_IRETURN_DATA)) shr 8;
colorNormalType := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_NORMAL_TYPE, ''), DEFAULT_DEBUGGER_COLOR_NORMAL_TYPE)) shr 8;
colorObjectType := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_OBJECT_TYPE, ''), DEFAULT_DEBUGGER_COLOR_OBJECT_TYPE)) shr 8;
colorExceptType := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_EXCEPT_TYPE, ''), DEFAULT_DEBUGGER_COLOR_EXCEPT_TYPE)) shr 8;
colorOldEBPType := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_OLDEBP_TYPE, ''), DEFAULT_DEBUGGER_COLOR_OLDEBP_TYPE)) shr 8;
colorReturnType := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_RETURN_TYPE, ''), DEFAULT_DEBUGGER_COLOR_RETURN_TYPE)) shr 8;
colorIReturnType := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_IRETURN_TYPE, ''), DEFAULT_DEBUGGER_COLOR_IRETURN_TYPE)) shr 8;
colorOverflowType := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_OVERFLOW_TYPE, ''), DEFAULT_DEBUGGER_COLOR_OVERFLOW_TYPE)) shr 8;
colorFunctionName := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_FUNCTION_NAME, ''), DEFAULT_DEBUGGER_COLOR_FUNCTION_NAME)) shr 8;
colorSourceLine := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_SOURCE_LINE, ''), DEFAULT_DEBUGGER_COLOR_SOURCE_LINE)) shr 8;
colorInherited := byteSwap(parseHexInt(mainwnd.getSetting(SECTION_DEBUGGER_COLORS, KEY_INHERITED, ''), DEFAULT_DEBUGGER_COLOR_INHERITED)) shr 8;
end;
destructor TDisassemblerForm.destroy;
begin
destroyInfo(allDebugInfo);
destroyInfo(classesInfo);
destroyInfo(variablesInfo);
destroyInfo(functionsInfo);
destroyGUI(guiStack);
destroyGUI(guiDebugInspector);
guiContext.free();
destroyGUI(guiStatus);
guiDisassembler.free();
currentContext.free();
image.free();
inherited destroy;
end;
procedure TDisassemblerForm.formShow(sender: TObject);
begin
disassemblerScrollbar.position := 0;
updateScreen();
end;
procedure TDisassemblerForm.formKeyDown(sender: TObject; var key: Word; shift: TShiftState);
begin
if (key = VK_F7) and (shift * [ssShift, ssCtrl, ssAlt] = []) then begin
{ F7 – шаг со входом }
stepIntoButtonClick(stepIntoButton);
key := 0;
exit;
end;
if (key = VK_F11) and (shift * [ssShift, ssCtrl, ssAlt] = []) and debugInspectorButton.enabled then begin
{ F11 – инспектор отладки }
debugInspectorButtonClick(debugInspectorButton);
key := 0;
exit;
end;
if (key = VK_RETURN) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Alt+Enter – переключение между оконным и полноэкранным режимом }
switchFullScreenMode();
key := 0;
exit;
end;
if (key = VK_D) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Alt+D – показать окно программы }
owner.showEmulationWindow();
key := 0;
exit;
end;
if (key = VK_M) and (shift * [ssShift, ssCtrl, ssAlt] = [ssAlt]) then begin
{ Alt+M – показать главное окно }
owner.getMainWindow().showMainWindow();
key := 0;
exit;
end;
end;
procedure TDisassemblerForm.formKeyUp(sender: TObject; var key: Word; shift: TShiftState);
begin
if (key = VK_F8) and (shift * [ssShift, ssCtrl, ssAlt] = []) then begin
{ F8 – шаг в обход }
stepOverButtonClick(stepOverButton);
key := 0;
exit;
end;
if (key = VK_F9) and (shift * [ssShift, ssCtrl, ssAlt] = []) then begin
{ F9 – запуск }
runButtonClick(runButton);
key := 0;
exit;
end;
if (key = VK_F9) and (shift * [ssShift, ssCtrl, ssAlt] = [ssShift]) then begin
{ Shift+F9 – скрыть дизассемблер и запуск }
hideAndRunButtonClick(hideAndRunButton);
key := 0;
exit;
end;
end;
procedure TDisassemblerForm.formResize(sender: TObject);
var
h: int;
begin
with debugInspectorPanel do begin
if left + width > self.clientWidth then begin
left := self.clientWidth - width;
end;
if top + height > self.clientHeight then begin
top := self.clientHeight - height;
end;
if left < 0 then begin
left := 0;
end;
if top < 0 then begin
top := 0;
end;
if left + width > self.clientWidth then begin
width := self.clientWidth - left;
end;
if top + height > self.clientHeight then begin
height := self.clientHeight - top;
end;
end;
h := abs(image.canvas.font.height);
if h = 0 then begin
exit;
end;
setupScrollbar(statusScrollbar, max(1, status.height div h));
setupScrollbar(contextScrollbar, max(1, context.height div h));
setupScrollbar(stackScrollbar, max(1, stack.height div h));
setupScrollbar(debugInspectorScrollbar, max(1, debugInspector.height div h));
end;
procedure TDisassemblerForm.formWindowStateChange(sender: TObject);
begin
disassemblerScrollbar.repaint();
statusScrollbar.repaint();
contextScrollbar.repaint();
stackScrollbar.repaint();
debugInspectorScrollbar.repaint();
end;
procedure TDisassemblerForm.formGUIElementPaint(sender: TObject);
var
element: GUIElement;
begin
element := getGUIElementFor(sender);
if element <> nil then begin
paintGUIElement(element);
end;
end;
procedure TDisassemblerForm.formGUIElementPointerPressed(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: integer);
var
element: GUIElement;
begin
element := getGUIElementFor(sender);
if element <> nil then begin
element.pointerPressed(x, y, button <> mbLeft);
end;
end;
procedure TDisassemblerForm.formGUIElementPointerReleased(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: integer);
var
element: GUIElement;
begin
element := getGUIElementFor(sender);
if element <> nil then begin
element.pointerReleased(x, y, button <> mbLeft);
end;
end;
procedure TDisassemblerForm.formGUIElementScroll(sender: TObject);
var
element: GUIElement;
begin
element := getGUIElementFor(sender);
if element <> nil then begin
element.position := TScrollBar(sender).position;
paintGUIElement(element);
end;
end;
procedure TDisassemblerForm.stepIntoButtonClick(sender: TObject);
var
i: int;
begin
if not owner.isNowDebugging() then begin
exit;
end;
i := contextID;
threadList.items.strings[i] := 'Поток ' + toDecString(i);
contextID := threadList.itemIndex;
stepInto := true;
owner.setDebug(true);
owner.programmeResume();
end;
procedure TDisassemblerForm.stepOverButtonClick(sender: TObject);
var
bytes: PByteArray;
opcode: int;
eip: int;
i: int;
begin
if not owner.isNowDebugging() then begin
exit;
end;
i := contextID;
threadList.items.strings[i] := 'Поток ' + toDecString(i);
contextID := threadList.itemIndex;
eip := currentContext.regEIP;
bytes := PByteArray(processor.getMemory(eip, 2));
if bytes <> nil then begin
if int(bytes[0]) = -1 then begin
opcode := $ff00 + (int(bytes[1]) and $ff)
end else begin
opcode := int(bytes[0]) and $ff;
end;
end else begin
opcode := 0;
end;
case opcode of
$b4..$b7, $b9, $fa, $ff50..$ff55: begin
stepOver := eip + getInstructionLength(eip);
owner.showEmulationWindow();
end;
else
stepInto := true;
end;
owner.setDebug(true);
owner.programmeResume();
end;
procedure TDisassemblerForm.runButtonClick(sender: TObject);
begin
if not owner.isNowDebugging() then begin
exit;
end;
owner.showEmulationWindow();
owner.setDebug(hasBreakpoints());
owner.programmeResume();
end;
procedure TDisassemblerForm.hideAndRunButtonClick(sender: TObject);
begin
if not owner.isNowDebugging() then begin
exit;
end;
windowState := wsMinimized;
owner.showEmulationWindow();
owner.setDebug(hasBreakpoints());
owner.programmeResume();
end;
procedure TDisassemblerForm.debugInspectorButtonClick(sender: TObject);
begin
if debugInspectorPanel.visible then begin
disassemblerScrollbar.setFocus();
debugInspectorPanel.visible := false;
end else begin
debugInspectorPanel.visible := true;
if debugInspectorScrollbar.enabled then begin
debugInspectorScrollbar.setFocus();
end;
end;
end;
procedure TDisassemblerForm.disassemblerScrollbarKeyDown(sender: TObject; var key: Word; shift: TShiftState);
begin
if ((key = VK_DOWN) or (key = VK_RIGHT)) and (shift * [ssShift, ssCtrl, ssAlt] = [ssCtrl]) then begin
if disassemblerPosition < MAX_INT then begin
inc(disassemblerPosition);
paintGUIElement(guiDisassembler);
end;
key := 0;
exit;
end;
if ((key = VK_UP) or (key = VK_LEFT)) and (shift * [ssShift, ssCtrl, ssAlt] = [ssCtrl]) then begin
if disassemblerPosition > 0 then begin
dec(disassemblerPosition);
paintGUIElement(guiDisassembler);
end;
key := 0;
exit;
end;
formKeyDown(sender, key, shift);
end;
procedure TDisassemblerForm.disassemblerScrollbarScroll(sender: TObject; action: TScrollCode; var position: integer);
var
a: int;
i: int;
begin
position := 0;
case action of
scLineUp: begin
i := 1;
while (i <= 10) and (disassemblerPosition - i >= 0) do begin
if getInstructionLength(disassemblerPosition - i) = i then begin
break;
end;
inc(i);
end;
dec(disassemblerPosition, i);
if disassemblerPosition < 0 then begin
disassemblerPosition := 0;
end;
end;
scLineDown: begin
inc(disassemblerPosition, getInstructionLength(disassemblerPosition));
if disassemblerPosition < 0 then begin
disassemblerPosition := MAX_INT;
end;
end;
scPageUp: begin
a := (disassembler.height div abs(image.canvas.font.height)) - 1;
i := 1;
while (i > 0) and (disassemblerPosition - i >= 0) do begin
if getInstructionsCount(disassemblerPosition - i, i) >= a then begin
break;
end;
inc(i);
end;
dec(disassemblerPosition, i);
if disassemblerPosition < 0 then begin
disassemblerPosition := 0;
end;
end;
scPageDown: begin
disassemblerPosition := maxVisibleAddress;
if disassemblerPosition < 0 then begin
disassemblerPosition := MAX_INT;
end;
end;
scTop: begin
disassemblerPosition := 0;
end;
scBottom: begin
disassemblerPosition := MAX_INT;
end;
end;
paintGUIElement(guiDisassembler);
end;
procedure TDisassemblerForm.threadListSelect(sender: TObject);
begin
processor.getContext(threadList.itemIndex, currentContext);
updateScreen();
end;
procedure TDisassemblerForm.debugInspectorCaptionSizeGripMouseDown(sender: TObject; button: TMouseButton; shift: TShiftState; x, y: integer);
begin
if button = mbLeft then begin
resizing := sender = debugInspectorSizeGrip;
self.x := x;
self.y := y;
end;
end;
procedure TDisassemblerForm.debugInspectorCaptionSizeGripMouseMove(sender: TObject; shift: TShiftState; x, y: integer);
var
l, t, w, h: int;
begin
if not (ssLeft in shift) then begin
exit;
end;
with debugInspectorPanel do begin
if resizing then begin
w := width + x - self.x;
h := height + y - self.y;
if left + w > self.width then begin
w := self.width - left;
end;
if top + h > self.height then begin
h := self.height - top;
end;
width := w;
height := h;
setupScrollbar(debugInspectorScrollbar, max(1, debugInspector.height div abs(image.canvas.font.height)));
end else begin
l := left + x - self.x;
t := top + y - self.y;
if l < 0 then begin
l := 0;
end;
if l + width > self.width then begin
l := self.width - width;
end;
if t < 0 then begin
t := 0;
end;
if t + height > self.height then begin
t := self.height - height;
end;
left := l;
top := t;
end;
end;
end;
procedure TDisassemblerForm.debugInspectorBackButtonClick(sender: TObject);
begin
guiDebugInspector[debugInspectorPages.activePageIndex].gotoPrevElement();
end;
procedure TDisassemblerForm.debugInspectorNextButtonClick(sender: TObject);
begin
guiDebugInspector[debugInspectorPages.activePageIndex].gotoNextElement();
end;
procedure TDisassemblerForm.debugInspectorMenuButtonClick(sender: TObject);
var
p: TPoint;
begin
p := debugInspectorBackButton.clientToScreen(point(0, debugInspectorBackButton.height));
guiDebugInspector[debugInspectorPages.activePageIndex].getMenu().popup(p.x, p.y);
end;
procedure TDisassemblerForm.debugInspectorCloseTabButtonClick(sender: TObject);
var
i: int;
j: int;
begin
j := debugInspectorPages.activePageIndex;
guiDebugInspector[j].free();
for i := j to guiDebugInspectorCount - 2 do begin
guiDebugInspector[i] := guiDebugInspector[i + 1];
end;
dec(guiDebugInspectorCount);
guiDebugInspector[guiDebugInspectorCount] := nil;
debugInspectorPages.pages[j].free();
if guiDebugInspectorCount > 0 then begin
debugInspector.repaint();
end else begin
debugInspectorPanel.visible := false;
debugInspectorButton.enabled := false;
end;
end;
procedure TDisassemblerForm.debugInspectorSizeGripPaint(sender: TObject);
begin
with debugInspectorSizeGrip.canvas, themeServices() do begin
if themesAvailable and themesEnabled then begin
drawElement(handle, getElementDetails(TThemedScrollBar.tsSizeBoxRightAlign), bounds(0, 0, debugInspectorSizeGrip.width, debugInspectorSizeGrip.height));
end else begin
drawFrameControl(handle, bounds(0, 0, debugInspectorSizeGrip.width, debugInspectorSizeGrip.height), DFC_SCROLL, DFCS_SCROLLSIZEGRIP);
end;
end;
end;
procedure TDisassemblerForm.debugInspectorHistoryMenuClickItem(sender: TObject);
begin
guiDebugInspector[debugInspectorPages.activePageIndex].gotoElement(TMenuItem(sender).tag);
end;
function TDisassemblerForm.findClassInfo(const className: AnsiString): ClassDebugInfo;
var
i: int;
d: ClassDebugInfo;
c: ClassDebugInfo_Array1d;
begin
c := classesInfo;
for i := 0 to length(c) - 1 do begin
d := c[i];
if (d <> nil) and (d.getInfo() = className) then begin
result := d;
exit;
end;
end;
result := nil;
end;
function TDisassemblerForm.getDebugInfo(address: int; const info: DebugInfo_Array1d): AnsiString;
var
a: int;
b: int;
c: int;
p: int;
i: DebugInfo;
begin
result := '';
a := 0;
b := length(info) - 1;
while a <= b do begin
c := (a + b) shr 1;
i := info[c];
p := address - i.getAddress();
if p > 0 then begin
a := c + 1;
end else
if p < 0 then begin
b := c - 1;
end else begin
result := i.getInfo();
break;
end;
end;
end;
function TDisassemblerForm.getClassInfo(address: int; const info: ClassDebugInfo_Array1d): ClassDebugInfo;
var
a: int;
b: int;
c: int;
p: int;
i: ClassDebugInfo;
begin
result := nil;
a := 0;
b := length(info) - 1;
while a <= b do begin
c := (a + b) shr 1;
i := info[c];
if i <> nil then begin
p := address - i.getAddress();
end else begin
p := 0;
end;
if p > 0 then begin
a := c + 1;
end else
if p < 0 then begin
b := c - 1;
end else begin
result := i;
break;
end;
end;
end;
function TDisassemblerForm.getFunctionAt(address: int): DebugInfo;
var
a: int;
b: int;
c: int;
i: int;
len: int;
info: DebugInfo_Array1d;
begin
info := functionsInfo;
len := length(info);
if (len = 0) or (address < info[0].getAddress()) then begin
result := nil;
exit;
end;
a := 0;
b := len - 1;
c := -1;
while a <= b do begin
c := (a + b) shr 1;
i := address - info[c].getAddress();
if i > 0 then begin
a := c + 1;
end else
if i < 0 then begin
b := c - 1;
end else begin
break;
end;
end;
if a > b then begin
if (a < len) and (b >= 0) then begin
for i := a downto b do begin
if info[i].getAddress() < address then begin
c := i;
break;
end;
end;
end;
end else begin
for i := c - 1 downto 0 do begin
if info[i].getAddress() <> address then begin
c := i + 1;
break;
end;
end;
end;
if c >= 0 then begin
result := info[c];
end else begin
result := nil;
end;
end;
function TDisassemblerForm.getAddressRepresentation(address: int): AnsiString;
var
func: DebugInfo;
begin
result := getDebugInfo(address, functionsInfo);
if length(result) > 0 then begin
result := getFunctionRepresentation(result);
exit;
end;
result := getDebugInfo(address, variablesInfo);
if length(result) > 0 then begin
result := getVariableRepresentation(result);
exit;
end;
func := getFunctionAt(address);
if func <> nil then begin
result := getFunctionRepresentation(func.getInfo()) + ' + ' + DATA_REPRESENTER.getHexRepresentation(address - func.getAddress()) + ' (' + DATA_REPRESENTER.getHexRepresentation(address) + ')';
exit;
end;
result := DATA_REPRESENTER.getHexRepresentation(address);
end;
function TDisassemblerForm.getValueRepresentation(address: int; const typeInfo: AnsiString): AnsiString;
var
p: Pointer;
begin
p := processor.getMemory(address, 10);
if p = nil then begin
result := '???';
exit;
end;
if length(typeInfo) <= 0 then begin
result := 'N/T'; { Not a Type - пустая строка «не является типом» }
exit;
end;
case typeInfo[1] of
SIGNATURE_BOOLEAN: begin
result := DATA_REPRESENTER.getLongRepresentation(byte(p^), DATA_TYPE_BOOLEAN);
end;
SIGNATURE_BYTE: begin
result := DATA_REPRESENTER.getLongRepresentation(byte(p^), DATA_TYPE_BYTE);
end;
SIGNATURE_SHORT: begin
result := DATA_REPRESENTER.getLongRepresentation(short(p^), DATA_TYPE_SHORT);
end;
SIGNATURE_INT: begin
result := DATA_REPRESENTER.getLongRepresentation(int(p^), DATA_TYPE_INT);
end;
SIGNATURE_LONG: begin
result := DATA_REPRESENTER.getLongRepresentation(long(p^), DATA_TYPE_LONG);
end;
SIGNATURE_WCHAR: begin
result := DATA_REPRESENTER.getLongRepresentation(short(p^), DATA_TYPE_WCHAR);
end;
SIGNATURE_ICHAR: begin
result := DATA_REPRESENTER.getLongRepresentation(int(p^), DATA_TYPE_ICHAR);
end;
SIGNATURE_FLOAT: begin
result := DATA_REPRESENTER.getFloatRepresentation(float(p^));
end;
SIGNATURE_DOUBLE: begin
result := DATA_REPRESENTER.getDoubleRepresentation(double(p^));
end;
SIGNATURE_REAL: begin
result := DATA_REPRESENTER.getRealRepresentation(real(p^));
end;
SIGNATURE_OBJECT, SIGNATURE_CLASS, SIGNATURE_ARRAY: begin
result := DATA_REPRESENTER.getObjectRepresentation(int(p^));
end;
else
result := 'U/T'; { Unknown Type - неизвестный тип }
end;
end;
function TDisassemblerForm.getInstructionByteCode(address: int): AnsiString;
var
bytes: PByteArray;
b: int;
i: int;
len: int;
begin
len := getInstructionLength(address);
if len > 11 then begin
len := 11;
end;
bytes := PByteArray(processor.getMemory(address, len));
if bytes = nil then begin
result := '??';
exit;
end;
result := String_create(len * 2);
for i := 0 to len - 1 do begin
b := int(bytes[i]) and $ff;
result[2 * i + 1] := HEX_DIGITS[(b shr $4) + 1];
result[2 * i + 2] := HEX_DIGITS[(b and $f) + 1];
end;
end;
function TDisassemblerForm.getInstructionRepresentation(address: int): AnsiString;
var
bytes: PByteArray;
byte1: int;
byte2: int;
byte3: int;
deflb: int;
value: int;
val1: long;
val2: long;
size: long;
r: Representer;
begin
bytes := PByteArray(processor.getMemory(address, 22));
if bytes = nil then begin
result := '???';
exit;
end;
byte1 := int(bytes[0]) and $ff;
byte2 := int(bytes[1]) and $ff;
byte3 := int(bytes[2]) and $ff;
r := DATA_REPRESENTER;
result := INSTRUCTIONS_NAMES[byte1];
case byte1 of
$00, $10, $12, $14, $16, $18..$1f, $2f, $3f, $50..$73, $77, $7b..$af, $b8..$bb, $bc, $be, $cf,
$df, $f0..$f8, $fc..$fe: { для проверки };
$01, $09: begin
result := result + r.getLongRepresentation(bytes[1], DATA_TYPE_BYTE);
end;
$02, $0a: begin
result := result + r.getLongRepresentation(short((@(bytes[1]))^), DATA_TYPE_SHORT);
end;
$03, $0b: begin
result := result + r.getLongRepresentation(int((@(bytes[1]))^), DATA_TYPE_ICHAR);
end;
$04: begin
result := result + r.getLongRepresentation(long((@(bytes[1]))^), DATA_TYPE_LONG);
end;
$05, $0d..$0e: begin
result := result + r.getFloatRepresentation(float((@(bytes[1]))^));
end;
$06, $0f: begin
result := result + r.getDoubleRepresentation(double((@(bytes[1]))^));
end;
$07: begin
result := result + r.getRealRepresentation(real((@(bytes[1]))^));
end;
$b3, $b7: begin
result := result + getAddressRepresentation(int((@(bytes[1]))^));
end;
$0c: begin
result := result + r.getLongRepresentation(short((@(bytes[1]))^), DATA_TYPE_WCHAR);
end;
$11, $13, $15: begin
result := result + toDecString(int(short((@(bytes[1]))^)) and $ffff);
end;
$17: begin
result := result + toDecString(int(short((@(bytes[1]))^)) and $ffff) + ' x ' + toDecString(int(short((@(bytes[3]))^)) and $ffff);
end;
$20..$2e, $30..$3e: begin
result := result + '[' + getAddressRepresentation(int((@(bytes[1]))^)) + ']';
end;
$40, $42..$48, $4a..$4f: begin
result := result + '[esp+' + r.getHexRepresentation((int(short((@(bytes[1]))^)) and $ffff) shl 4) + ']';
end;
$41, $49: begin
result := result + '[esp+' + r.getHexRepresentation(int((@(bytes[1]))^) shl 4) + ']';
end;
$74..$76, $78..$7a: begin
result := result + r.getLongRepresentation(int(bytes[1]) and $ff, DATA_TYPE_INT);
end;
$b0, $b4: begin
result := result + getAddressRepresentation(address + int(bytes[1]) + 2);
end;
$b1, $b5: begin
result := result + getAddressRepresentation(address + int(short((@(bytes[1]))^)) + 3);
end;
$b2, $b6, $08: begin
result := result + getAddressRepresentation(address + int((@(bytes[1]))^) + 5);
end;
$bd, $bf: begin
result := result + toDecString(int(bytes[1]) and $ff);
end;
$fa: begin
result := result + r.getHexRepresentation(int(bytes[1]) and $ff);
end;
$c0..$ce, $d0..$de: begin
value := sar(int((@(bytes[0]))^), 8);
if value >= 0 then begin
result := result + '+' + r.getHexRepresentation(value);
end else begin
result := result + '-' + r.getHexRepresentation(-value);
end;
end;
$e0, $e2..$e8, $ea..$ef: begin
value := int(short((@(bytes[1]))^)) shl 4;
if value >= 0 then begin
result := result + '[ebp+' + r.getHexRepresentation(value) + ']';
end else begin
result := result + '[ebp-' + r.getHexRepresentation(-value) + ']';
end;
end;
$e1, $e9: begin
value := int((@(bytes[1]))^) shl 4;
if value >= 0 then begin
result := result + '[ebp+' + r.getHexRepresentation(value) + ']';
end else begin
result := result + '[ebp-' + r.getHexRepresentation(-value) + ']';
end;
end;
$f9, $fb: begin
result := result + r.getHexRepresentation(int(short((@(bytes[1]))^)) and $ffff);
end;
$ff: begin
result := INSTRUCTIONS_NAMES[byte2 + $100];
case byte2 of
$00..$1f, $56..$57, $60..$7f, $b0..$bf, $f2..$f3, $f6..$f7, $fa..$fb, $fe:
{ для проверки };
$20..$2f: begin
result := result + getAddressRepresentation(address + int(bytes[2]) + 3);
end;
$30..$3f: begin
result := result + getAddressRepresentation(address + int(short((@(bytes[2]))^)) + 4);
end;
$40..$4f: begin
result := result + getAddressRepresentation(address + int((@(bytes[2]))^) + 6);
end;
$50..$55: begin
result := result + r.getHexRepresentation(int(bytes[2]) and $ff);
end;
$58: begin
val1 := bytes[2];
val2 := bytes[3];
size := (val2 - val1) * 4 + 12;
deflb := address + int((@(bytes[4]))^) + int(size);
result := result +
'{size=' + r.getLongRepresentation(size, DATA_TYPE_LONG) +
', min=' + r.getLongRepresentation(val1, DATA_TYPE_BYTE) +
', max=' + r.getLongRepresentation(val2, DATA_TYPE_BYTE) +
', default=' + r.getHexRepresentation(deflb) + '}'
;
end;
$59: begin
val1 := short((@(bytes[2]))^);
val2 := short((@(bytes[4]))^);
size := (val2 - val1) * 4 + 14;
deflb := address + int((@(bytes[6]))^) + int(size);
result := result +
'{size=' + r.getLongRepresentation(size, DATA_TYPE_LONG) +
', min=' + r.getLongRepresentation(val1, DATA_TYPE_SHORT) +
', max=' + r.getLongRepresentation(val2, DATA_TYPE_SHORT) +
', default=' + r.getHexRepresentation(deflb) + '}'
;
end;
$5a: begin
val1 := int((@(bytes[2]))^);
val2 := int((@(bytes[6]))^);
size := (val2 - val1) * 4 + 18;
deflb := address + int((@(bytes[10]))^) + int(size);
result := result +
'{size=' + r.getLongRepresentation(size, DATA_TYPE_LONG) +
', min=' + r.getLongRepresentation(val1, DATA_TYPE_INT) +
', max=' + r.getLongRepresentation(val2, DATA_TYPE_INT) +
', default=' + r.getHexRepresentation(deflb) + '}'
;
end;
$5b: begin
val1 := long((@(bytes[2]))^);
val2 := long((@(bytes[10]))^);
size := (val2 - val1) * 4 + 26;
deflb := address + int((@(bytes[18]))^) + int(size);
result := result +
'{size=' + r.getLongRepresentation(size, DATA_TYPE_LONG) +
', min=' + r.getLongRepresentation(val1, DATA_TYPE_LONG) +
', max=' + r.getLongRepresentation(val2, DATA_TYPE_LONG) +
', default=' + r.getHexRepresentation(deflb) + '}'
;
end;
$5c: begin
value := int(short((@(bytes[2]))^)) and $ffff;
size := long(value) * 5 + 8;
deflb := address + int((@(bytes[4]))^) + int(size);
result := result +
'{size=' + r.getLongRepresentation(size, DATA_TYPE_LONG) +
', labels=' + r.getLongRepresentation(value, DATA_TYPE_INT) +
', default=' + r.getHexRepresentation(deflb) + '}'
;
end;
$5d: begin
value := int(short((@(bytes[2]))^)) and $ffff;
size := long(value) * 6 + 8;
deflb := address + int((@(bytes[4]))^) + int(size);
result := result +
'{size=' + r.getLongRepresentation(size, DATA_TYPE_LONG) +
', labels=' + r.getLongRepresentation(value, DATA_TYPE_INT) +
', default=' + r.getHexRepresentation(deflb) + '}'
;
end;
$5e: begin
value := int(short((@(bytes[2]))^)) and $ffff;
size := long(value) * 8 + 8;
deflb := address + int((@(bytes[4]))^) + int(size);
result := result +
'{size=' + r.getLongRepresentation(size, DATA_TYPE_LONG) +
', labels=' + r.getLongRepresentation(value, DATA_TYPE_INT) +
', default=' + r.getHexRepresentation(deflb) + '}'
;
end;
$5f: begin
value := int(short((@(bytes[2]))^)) and $ffff;
size := long(value) * 12 + 8;
deflb := address + int((@(bytes[4]))^) + int(size);
result := result +
'{size=' + r.getLongRepresentation(size, DATA_TYPE_LONG) +
', labels=' + r.getLongRepresentation(value, DATA_TYPE_INT) +
', default=' + r.getHexRepresentation(deflb) + '}'
;
end;
$80..$a3, $a7, $ab..$af, $f0, $f4, $f8, $fc: begin
result := result + '[esp+' + r.getHexRepresentation((int(short((@(bytes[2]))^)) and $ffff) shl 4) + ']';
end;
$a4..$a6, $a8..$aa: begin
result := result + '[esp+' + r.getHexRepresentation((int(short((@(bytes[2]))^)) and $ffff) shl 4) + '], ' + r.getLongRepresentation(int(bytes[4]) and $ff, DATA_TYPE_INT);
end;
$c0..$e3, $e7, $eb..$ef, $f1, $f5, $f9, $fd: begin
value := int(short((@(bytes[2]))^)) shl 4;
if value >= 0 then begin
result := result + '[ebp+' + r.getHexRepresentation(value) + ']';
end else begin
result := result + '[ebp-' + r.getHexRepresentation(-value) + ']';
end;
end;
$e4..$e6, $e8..$ea: begin
value := int(short((@(bytes[2]))^)) shl 4;
if value >= 0 then begin
result := result + '[ebp+' + r.getHexRepresentation(value) + '], ';
end else begin
result := result + '[ebp-' + r.getHexRepresentation(-value) + '], ';
end;
result := result + r.getLongRepresentation(int(bytes[4]) and $ff, DATA_TYPE_INT);
end;
$ff: begin
if byte3 + $200 < length(INSTRUCTIONS_NAMES) then begin
result := INSTRUCTIONS_NAMES[byte3 + $200];
case byte3 of
$30: begin
result := result + '[esp+' + r.getHexRepresentation((int(short((@(bytes[3]))^)) and $ffff) shl 4) + ']';
end;
$31: begin
value := int(short((@(bytes[3]))^)) shl 4;
if value >= 0 then begin
result := result + '[ebp+' + r.getHexRepresentation(value) + ']';
end else begin
result := result + '[ebp-' + r.getHexRepresentation(-value) + ']';
end;
end;
$32: begin
result := result + getAddressRepresentation(address + int(bytes[3]) + 4);
end;
end;
end else begin
result := '(bad)';
end;
end;
end;
end;
end;
end;
function TDisassemblerForm.getInstructionLength(address: int): int;
var
bytes: PByteArray;
byte1: int;
byte2: int;
byte3: int;
value: int;
val1: long;
val2: long;
begin
bytes := processor.getMemory(address, 22);
if bytes = nil then begin
result := 1;
exit;
end;
byte1 := int(bytes[0]) and $ff;
byte2 := int(bytes[1]) and $ff;
byte3 := int(bytes[2]) and $ff;
case byte1 of
$00, $10, $12, $14, $16, $18..$1f, $2f, $3f, $50..$73, $77, $7b..$af, $b8..$bb, $bc, $be, $cf,
$df, $f0..$f8, $fc..$fe: begin
result := 1;
end;
$01, $09, $74..$76, $78..$7a, $b0, $b4, $bd, $bf, $fa: begin
result := 2;
end;
$02, $0a, $0c, $11, $13, $15, $40, $42..$48, $4a..$4f, $b1, $b5, $e0, $e2..$e8, $ea..$ef,
$f9, $fb: begin
result := 3;
end;
$c0..$ce, $d0..$de: begin
result := 4;
end;
$03, $05, $08, $0b, $0d..$0e, $17, $20..$2e, $30..$3e, $41, $49, $b2..$b3, $b6..$b7,
$e1, $e9: begin
result := 5;
end;
$04, $06, $0f: begin
result := 9;
end;
$07: begin
result := 11;
end;
$ff: begin
case byte2 of
$00..$1f, $56..$57, $60..$7f, $b0..$bf, $f2..$f3, $f6..$f7, $fa..$fb, $fe: begin
result := 2;
end;
$20..$2f, $50..$55: begin
result := 3;
end;
$30..$3f, $80..$a3, $a7, $ab..$af, $c0..$e3, $e7, $eb..$f1,
$f4..$f5, $f8..$f9, $fc..$fd: begin
result := 4;
end;
$a4..$a6, $a8..$aa, $e4..$e6, $e8..$ea: begin
result := 5;
end;
$40..$4f: begin
result := 6;
end;
$58: begin
val1 := bytes[2];
val2 := bytes[3];
result := int(val2 - val1) * 4 + 12;
end;
$59: begin
val1 := short((@(bytes[2]))^);
val2 := short((@(bytes[4]))^);
result := int(val2 - val1) * 4 + 14;
end;
$5a: begin
val1 := int((@(bytes[2]))^);
val2 := int((@(bytes[6]))^);
result := int(val2 - val1) * 4 + 18;
end;
$5b: begin
val1 := long((@(bytes[2]))^);
val2 := long((@(bytes[10]))^);
result := int(val2 - val1) * 4 + 26;
end;
$5c: begin
value := int(short((@(bytes[2]))^)) and $ffff;
result := value * 5 + 8;
end;
$5d: begin
value := int(short((@(bytes[2]))^)) and $ffff;
result := value * 6 + 8;
end;
$5e: begin
value := int(short((@(bytes[2]))^)) and $ffff;
result := value * 8 + 8;
end;
$5f: begin
value := int(short((@(bytes[2]))^)) and $ffff;
result := value * 12 + 8;
end;
$ff: begin
case byte3 of
$30..$31: begin
result := 5;
end;
$32, $ff: begin
result := 4;
end;
else
result := 3;
end;
end;
else
result := 0;
end;
end;
else
result := 0;
end;
end;
function TDisassemblerForm.getInstructionsCount(address, size: int): int;
var
len: int;
begin
result := 0;
while size > 0 do begin
if length(getDebugInfo(address, functionsInfo)) > 0 then begin
inc(result);
end;
if length(getDebugInfo(address, allDebugInfo)) > 0 then begin
inc(result);
end;
len := getInstructionLength(address);
inc(address, len);
dec(size, len);
inc(result);
end;
end;
function TDisassemblerForm.getGUIElementFor(sender: TObject): GUIElement;
begin
if sender = disassembler then begin
result := guiDisassembler;
end else
if (sender = status) or (sender = statusPages) or (sender = statusScrollbar) then begin
result := guiStatus[statusPages.activePageIndex];
end else
if (sender = context) or (sender = contextScrollbar) then begin
result := guiContext;
end else
if (sender = stack) or (sender = stackPages) or (sender = stackScrollbar) then begin
result := guiStack[stackPages.activePageIndex];
end else
if ((sender = debugInspector) or (sender = debugInspectorPages) or (sender = debugInspectorScrollbar)) and (guiDebugInspectorCount > 0) then begin
result := guiDebugInspector[debugInspectorPages.activePageIndex];
end else begin
result := nil;
end;
end;
function TDisassemblerForm.hasBreakpointAt(address: int): boolean;
var
i: int;
begin
result := false;
for i := 0 to breakpointsCount - 1 do begin
if breakpoints[i] = address then begin
result := true;
break;
end;
end;
end;
procedure TDisassemblerForm.updateScreen();
var
c: MalikDebugContext;
begin
if (maxVisibleAddress = 0) or (currentContext.regEIP < disassemblerPosition) or (currentContext.regEIP >= maxVisibleAddress) then begin
disassemblerPosition := currentContext.regEIP;
if disassemblerPosition < 0 then begin
disassemblerPosition := MAX_INT;
end;
end;
paintGUIElement(guiDisassembler);
paintGUIElement(guiStatus[statusPages.activePageIndex]);
paintGUIElement(guiContext);
paintGUIElement(guiStack[stackPages.activePageIndex]);
if debugInspectorPanel.visible then begin
paintGUIElement(guiDebugInspector[debugInspectorPages.activePageIndex]);
end;
if stackPages.activePageIndex = 0 then begin
c := currentContext;
stackScrollbar.position := ((c.regESP - c.stackBegin) div sizeof(StackItem)) - 8;
end;
end;
procedure TDisassemblerForm.showContext(id: int);
var
i: int;
begin
i := contextID;
threadList.items.strings[i] := 'Поток ' + toDecString(i);
threadList.items.strings[id] := 'Поток ' + toDecString(id) + ' (текущий)';
threadList.itemIndex := id;
processor.getContext(id, currentContext);
contextID := id;
updateScreen();
end;
procedure TDisassemblerForm.addDebugInspectorElement(const tabCaption, dataType: AnsiString; address: int);
var
d: DebugInspectorHistory_Array1d;
c: int;
begin
d := guiDebugInspector;
c := guiDebugInspectorCount;
if c = length(d) then begin
d := DebugInspectorHistory_Array1d_create(c + 16);
arraycopy(guiDebugInspector, 0, d, 0, c);
guiDebugInspector := d;
end;
d[c] := DebugInspectorHistory.create(self, debugInspector, debugInspectorScrollbar, dataType, address);
guiDebugInspectorCount := c + 1;
debugInspectorButton.enabled := true;
debugInspectorPanel.visible := true;
with debugInspectorPages.addTabSheet() do begin
caption := tabCaption;
show();
end;
debugInspector.repaint();
end;
procedure TDisassemblerForm.paintGUIElement(element: GUIElement);
var
w: int;
h: int;
box: TPaintBox;
scroll: TScrollBar;
begin
if element = nil then begin
exit;
end;
box := element.box;
scroll := element.scroll;
if scroll <> nil then begin
scroll.onChange := nil;
try
setupScrollbar(scroll, element.getLinesCount(), element.position);
finally
scroll.onChange := formGUIElementScroll;
end;
end;
w := box.clientWidth;
h := box.clientHeight;
with image do begin
setSize(w, h);
canvas.brush.style := bsSolid;
canvas.brush.color := clBtnFace;
canvas.fillRect(0, 0, w, h);
if scroll <> nil then begin
element.paint(canvas, w, h, scroll.position);
end else begin
element.paint(canvas, w, h, disassemblerPosition);
end;
end;
box.parent.update();
box.canvas.clipRect := rect(0, 0, w, h);
box.canvas.draw(0, 0, image);
end;
procedure TDisassemblerForm.destroyGUI(const arr: GUIElement_Array1d);
var
i: int;
begin
for i := 0 to length(arr) - 1 do begin
arr[i].free();
end;
end;
procedure TDisassemblerForm.destroyGUI(const arr: DebugInspectorHistory_Array1d);
var
i: int;
begin
for i := 0 to length(arr) - 1 do begin
arr[i].free();
end;
end;
procedure TDisassemblerForm.destroyInfo(const arr: DebugInfo_Array1d);
var
i: int;
begin
for i := 0 to length(arr) - 1 do begin
arr[i].free();
end;
end;
procedure TDisassemblerForm.destroyInfo(const arr: ClassDebugInfo_Array1d);
var
i: int;
begin
for i := 0 to length(arr) - 1 do begin
arr[i].free();
end;
end;
procedure TDisassemblerForm.loadDataFrom(strs: TStrings);
var
info: AnsiString;
s: AnsiString;
i: int;
j: int;
k: int;
classCount: int;
varCount: int;
funcCount: int;
debugCount: int;
address: int;
clinfo: ClassDebugInfo;
begin
classCount := 0;
varCount := 0;
funcCount := 0;
debugCount := 0;
for i := 0 to strs.count - 1 do begin
s := strs.strings[i];
j := pos('=', s);
if (length(s) = 0) or (s[1] in ['+', '-']) or (j < 2) then begin
continue;
end;
info := trim(copy(s, j + 1, length(s) - j));
if pos(PREFIX_CLASS, info) = 1 then begin
inc(classCount);
end else
if pos(PREFIX_VARIABLE, info) = 1 then begin
inc(varCount);
end else
if pos(PREFIX_FUNCTION, info) = 1 then begin
inc(funcCount);
end else begin
inc(debugCount);
end;
end;
classesInfo := ClassDebugInfo_Array1d_create(classCount);
variablesInfo := DebugInfo_Array1d_create(varCount);
functionsInfo := DebugInfo_Array1d_create(funcCount);
allDebugInfo := DebugInfo_Array1d_create(debugCount);
classCount := 0;
varCount := 0;
funcCount := 0;
debugCount := 0;
for i := 0 to strs.count - 1 do begin
s := strs.strings[i];
j := pos('=', s);
if (length(s) = 0) or (s[1] in ['+', '-']) or (j < 2) then begin
continue;
end;
address := parseHexInt(copy(s, 1, j - 1), -1);
info := trim(copy(s, j + 1, length(s) - j));
if pos(PREFIX_CLASS, info) = 1 then begin
info := trim(copy(info, length(PREFIX_CLASS) + 1, length(s) - length(PREFIX_CLASS)));
j := pos(':', info);
if j = 0 then begin
j := length(info) + 1;
end;
classesInfo[classCount] := ClassDebugInfo.create(address, trim(copy(info, 1, j - 1)));
inc(classCount);
end else
if pos(PREFIX_VARIABLE, info) = 1 then begin
info := trim(copy(info, length(PREFIX_VARIABLE) + 1, length(s) - length(PREFIX_VARIABLE)));
variablesInfo[varCount] := DebugInfo.create(address, info);
inc(varCount);
end else
if pos(PREFIX_FUNCTION, info) = 1 then begin
info := trim(copy(info, length(PREFIX_FUNCTION) + 1, length(s) - length(PREFIX_FUNCTION)));
functionsInfo[funcCount] := DebugInfo.create(address, info);
inc(funcCount);
end else begin
info := trim(info);
allDebugInfo[debugCount] := DebugInfo.create(address, info);
inc(debugCount);
end;
end;
classCount := 0;
for i := 0 to strs.count - 1 do begin
s := strs.strings[i];
j := pos('=', s);
if (length(s) > 0) and (s[1] in ['+', '-']) and (j > 1) then begin
address := parseHexInt(trim(copy(s, 2, j - 2)), 0);
if s[1] = '-' then begin
address := -address;
end;
info := trim(copy(s, j + 1, length(s) - j));
j := pos('.', info);
if j = 0 then begin
continue;
end;
clinfo := findClassInfo(SIGNATURE_OBJECT + trim(copy(info, 1, j - 1)) + SIGNATURE_SUFFIX);
info := trim(copy(info, j + 1, length(info) - j));
if (clinfo <> nil) and (pos(':', info) > 0) then begin
clinfo.addField(address, info);
end;
continue;
end;
if (length(s) = 0) or (s[1] in ['+', '-']) or (j < 2) then begin
continue;
end;
info := copy(s, j + 1, length(s) - j);
if pos(PREFIX_CLASS, info) = 1 then begin
info := trim(copy(info, length(PREFIX_CLASS) + 1, length(s) - length(PREFIX_CLASS)));
k := pos(':', info);
if k = 0 then begin
continue;
end;
clinfo := getClassInfo(parseHexInt(copy(s, 1, j - 1), -1), classesInfo);
if clinfo <> nil then begin
clinfo.setParent(findClassInfo(trim(copy(info, k + 1, length(info) - k))));
end;
end;
end;
end;
procedure TDisassemblerForm.setupScrollbar(scrollbar: TScrollBar; maxval, position: int);
begin
scrollbar.max := max(0, maxval - scrollbar.largeChange);
scrollbar.position := position;
scrollbar.enabled := true;
scrollbar.enabled := scrollbar.max > 0;
scrollbar.repaint();
end;
procedure TDisassemblerForm.setupScrollbar(scrollbar: TScrollBar; page: int);
var
element: GUIElement;
begin
element := getGUIElementFor(scrollbar);
if element <> nil then begin
scrollbar.max := max(0, element.getLinesCount() - page);
end;
scrollbar.largeChange := page;
scrollbar.enabled := true;
scrollbar.enabled := scrollbar.max > 0;
scrollbar.repaint();
end;
procedure TDisassemblerForm.switchFullScreenMode();
begin
if windowState = wsNormal then begin
windowState := wsMaximized;
end else begin
windowState := wsNormal;
end;
end;
procedure TDisassemblerForm.afterConstruction();
begin
inherited afterConstruction();
statusPages.onKeyDown := formKeyDown;
statusPages.onKeyUp := formKeyUp;
stackPages.onKeyDown := formKeyDown;
stackPages.onKeyUp := formKeyUp;
debugInspectorPages.onKeyDown := formKeyDown;
debugInspectorPages.onKeyUp := formKeyUp;
image.canvas.font := disassembler.font;
guiDisassembler := GUIElementDisassembler.create(self, disassembler, nil);
guiStatus := toGUIElementArray1d([
GUIElementGlobalVariables.create(self, status, statusScrollbar),
GUIElementAllClasses.create(self, status, statusScrollbar),
GUIElementAllFunctions.create(self, status, statusScrollbar),
GUIElementExceptions.create(self, status, statusScrollbar),
GUIElementBreakpoints.create(self, status, statusScrollbar)
]);
guiContext := GUIElementContext.create(self, context, contextScrollbar);
guiStack := toGUIElementArray1d([
GUIElementStack.create(self, stack, stackScrollbar),
GUIElementCallStack.create(self, stack, stackScrollbar)
]);
end;
procedure TDisassemblerForm.loadData();
var
strs: TStrings;
info: ProgrammeInfo;
fs: FileInputStream;
ss: TStream;
i: int;
begin
with threadList, items do begin
clear();
for i := 0 to processor.MAX_CONTEXTS - 1 do begin
add('Поток ' + toDecString(i));
end;
itemIndex := 0;
end;
strs := TStringList.create();
try
info := ProgrammeInfo.create(owner.getProgrammeDirectory());
try
fs := FileInputStream.create(info.getDebugInfoFileName());
try
if fs.isInvalidHandle() then begin
exit;
end;
ss := THandleStream.create(fs.getHandle());
try
strs.loadFromStream(ss);
loadDataFrom(strs);
finally
ss.free();
end;
finally
fs.free();
end;
finally
info.free();
end;
finally
strs.free();
end;
end;
procedure TDisassemblerForm.showContents(contextID: int);
begin
stepInto := false;
stepOver := 0;
showContext(contextID);
end;
function TDisassemblerForm.hasBreakpoints(): boolean;
begin
result := breakpointsCount > 0;
end;
function TDisassemblerForm.mustBreak(contextID, address: int): boolean;
begin
result := ((self.contextID = contextID) and (stepInto or ((stepOver <> 0) and (address = stepOver)))) or hasBreakpointAt(address);
end;
{%endregion}
{%region GUIElementDisassembler }
constructor GUIElementDisassembler.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self, box, scroll);
end;
procedure GUIElementDisassembler.paint(canvas: TCanvas; width, height, scrollPosition: int);
var
f: TDisassemblerForm;
c1: int;
c2: int;
len: int;
eip: int;
ih: int;
a: int;
h: int;
i: int;
j: int;
l: int;
s: AnsiString;
b: AnsiString;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
h := abs(canvas.font.height);
if h = 0 then begin
exit;
end;
c2 := canvas.textWidth('A');
c1 := c2 * 9 + 32;
c2 := c2 * 23 + c1;
eip := f.currentContext.regEIP;
ih := -1;
a := scrollPosition;
i := 0;
j := 0;
len := height div h;
f.addresses := int_Array1d_create(len + 1);
while i < height do begin
canvas.brush.style := bsClear;
s := f.getDebugInfo(a, f.functionsInfo);
if length(s) > 0 then begin
s := TDisassemblerForm.getFunctionRepresentation(s);
canvas.font.color := f.colorFunctionName;
canvas.font.style := [fsBold];
canvas.textOut(0, i, s);
if j < length(f.addresses) then begin
f.addresses[j] := a;
end;
inc(i, h);
inc(j);
end;
s := f.getDebugInfo(a, f.allDebugInfo);
if length(s) > 0 then begin
canvas.font.color := f.colorSourceLine;
canvas.font.style := [fsBold];
canvas.textOut(16, i, s);
if j < length(f.addresses) then begin
f.addresses[j] := a;
end;
inc(i, h);
inc(j);
end;
if a = f.currentContext.regEIP then begin
ih := i;
end;
s := f.getInstructionRepresentation(a);
b := f.getInstructionByteCode(a);
l := f.getInstructionLength(a);
canvas.font.color := f.colorNormalData;
canvas.font.style := [];
canvas.textOut(32, i, toHexString(zeroExtend(a), 8));
canvas.textOut(c1, i, b);
canvas.TextOut(c2, i, s);
if f.hasBreakpointAt(a) then begin
f.arrows.draw(canvas, 0, i + ((h - f.arrows.height) div 2) + 1, 3);
end;
if j < length(f.addresses) then begin
f.addresses[j] := a;
end;
if (a < eip) and (a + l > eip) then begin
a := eip;
end else begin
inc(a, l);
end;
inc(i, h);
inc(j);
end;
f.maxVisibleAddress := f.addresses[len];
if ih >= 0 then begin
canvas.pen.style := psSolid;
canvas.pen.width := 1;
canvas.pen.color := $78c030;
canvas.moveTo(32, ih + 1);
canvas.lineTo(width, ih + 1);
canvas.moveTo(32, ih + h + 1);
canvas.lineTo(width, ih + h + 1);
f.arrows.draw(canvas, 32 - f.arrows.width, ih + ((h - f.arrows.height) div 2) + 1, 1);
end;
end;
procedure GUIElementDisassembler.pointerPressed(x, y: int; auxButton: boolean);
var
f: TDisassemblerForm;
e: GUIElement;
h: int;
i: int;
len: int;
line: int;
index: int;
address: int;
b: int_Array1d;
begin
f := TDisassemblerForm_self;
if (not f.owner.isNowDebugging()) or auxButton or (x >= 32) then begin
exit;
end;
h := abs(f.image.canvas.font.height);
if h = 0 then begin
exit;
end;
line := y div h;
if line >= length(f.addresses) then begin
exit;
end;
address := f.addresses[line];
index := -1;
len := f.breakpointsCount;
for i := 0 to len - 1 do begin
if f.breakpoints[i] = address then begin
index := i;
break;
end;
end;
if index >= 0 then begin
for i := index to len - 2 do begin
f.breakpoints[i] := f.breakpoints[i + 1];
end;
f.breakpointsCount := len - 1;
end else begin
if length(f.breakpoints) = len then begin
b := int_Array1d_create(len + 16);
arraycopy(f.breakpoints, 0, b, 0, len);
f.breakpoints := b;
end;
f.breakpoints[len] := address;
f.breakpointsCount := len + 1;
end;
e := f.guiStatus[f.statusPages.activePageIndex];
repaint();
if e is GUIElementBreakpoints then begin
e.repaint();
end;
end;
{%endregion}
{%region GUIElementGlobalVariables }
constructor GUIElementGlobalVariables.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self, box, scroll);
end;
procedure GUIElementGlobalVariables.paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean);
var
f: TDisassemblerForm;
info: DebugInfo;
global: UnicodeString;
value: AnsiString;
varInfo: AnsiString;
typeInfo: AnsiString;
w: int;
colonPos: int;
begin
f := TDisassemblerForm_self;
info := f.variablesInfo[lineIndex];
varInfo := info.getInfo();
colonPos := pos(':', varInfo);
if colonPos > 0 then begin
typeInfo := trim(copy(varInfo, colonPos + 1, length(varInfo) - colonPos));
value := f.getValueRepresentation(info.getAddress(), typeInfo);
end else begin
typeInfo := '';
value := 'N/T';
end;
canvas.brush.style := bsClear;
canvas.font.style := [];
if highlighted then begin
canvas.font.color := clHighlightText;
end else begin
if (length(typeInfo) > 0) and (typeInfo[1] in [SIGNATURE_OBJECT, SIGNATURE_CLASS, SIGNATURE_ARRAY]) then begin
canvas.font.color := f.colorObjectData;
end else begin
canvas.font.color := f.colorNormalData;
end;
end;
global := toUTF16String(TDisassemblerForm.getVariableRepresentation(varInfo));
w := width - canvas.textWidth(value) - 32;
while (length(global) > 2) and (canvas.textWidth(toUTF8String(global)) > w) do begin
global := copy(global, 1, length(global) - 2) + #$2026;
{ $2026 – код символа многоточия («…») }
end;
canvas.textOut(left + 32, top, toUTF8String(global));
canvas.textOut(left + w + 32, top, value);
end;
procedure GUIElementGlobalVariables.paint(canvas: TCanvas; width, height, scrollPosition: int);
begin
if TDisassemblerForm_self.owner.isNowDebugging() then begin
inherited paint(canvas, width, height, scrollPosition);
end;
end;
procedure GUIElementGlobalVariables.lineClicked(lineIndex: int; auxButton: boolean);
var
f: TDisassemblerForm;
info: DebugInfo;
varInfo: AnsiString;
typeInfo: AnsiString;
colonPos: int;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
info := f.variablesInfo[lineIndex];
varInfo := info.getInfo();
colonPos := pos(':', varInfo);
if colonPos > 0 then begin
typeInfo := trim(copy(varInfo, colonPos + 1, length(varInfo) - colonPos));
end else begin
typeInfo := '';
end;
f.addDebugInspectorElement(TDisassemblerForm.getVariableRepresentation(varInfo), typeInfo, info.getAddress());
end;
function GUIElementGlobalVariables.getLinesCount(): int;
begin
result := length(TDisassemblerForm_self.variablesInfo);
end;
{%endregion}
{%region GUIElementAllClasses }
constructor GUIElementAllClasses.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self, box, scroll);
end;
procedure GUIElementAllClasses.paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean);
var
f: TDisassemblerForm;
clinfo: ClassDebugInfo;
parent: ClassDebugInfo;
r: Representer;
begin
canvas.brush.style := bsClear;
canvas.font.style := [];
f := TDisassemblerForm_self;
if highlighted then begin
canvas.font.color := clHighlightText;
end else begin
canvas.font.color := f.colorObjectData;
end;
clinfo := f.classesInfo[lineIndex];
parent := clinfo.getParent();
r := TDisassemblerForm.DATA_REPRESENTER;
if parent <> nil then begin
canvas.textOut(left + 32, top, r.getTypeRepresentation(clinfo.getInfo()) + ' : ' + r.getTypeRepresentation(parent.getInfo()));
end else begin
canvas.textOut(left + 32, top, r.getTypeRepresentation(clinfo.getInfo()));
end;
end;
procedure GUIElementAllClasses.lineClicked(lineIndex: int; auxButton: boolean);
var
f: TDisassemblerForm;
clinfo: ClassDebugInfo;
c: ClassDebugInfo_Array1d;
r: Representer;
i: int;
len: int;
size: int;
intArray: PIntArray;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
if classesRegion = 0 then begin
c := f.classesInfo;
len := length(c);
if len > 0 then begin
size := len * sizeof(int);
classesRegion := f.processor.createRegion(size);
intArray := PIntArray(f.processor.getMemory(classesRegion, size));
for i := 0 to len - 1 do begin
intArray[i] := c[i].getAddress();
end;
end;
end;
clinfo := f.classesInfo[lineIndex];
r := TDisassemblerForm.DATA_REPRESENTER;
f.addDebugInspectorElement(r.getTypeRepresentation(clinfo.getInfo()), SIGNATURE_OBJECT, classesRegion + lineIndex * sizeof(int));
end;
function GUIElementAllClasses.getLinesCount(): int;
begin
result := length(TDisassemblerForm_self.classesInfo);
end;
{%endregion}
{%region GUIElementAllFunctions }
constructor GUIElementAllFunctions.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self, box, scroll);
end;
procedure GUIElementAllFunctions.paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean);
var
f: TDisassemblerForm;
funcInfo: DebugInfo;
begin
canvas.brush.style := bsClear;
canvas.font.style := [];
f := TDisassemblerForm_self;
if highlighted then begin
canvas.font.color := clHighlightText;
end else begin
canvas.font.color := f.colorFunctionName;
end;
funcInfo := f.functionsInfo[lineIndex];
canvas.textOut(left, top, TDisassemblerForm.getFunctionRepresentation(funcInfo.getInfo()));
end;
procedure GUIElementAllFunctions.lineClicked(lineIndex: int; auxButton: boolean);
var
f: TDisassemblerForm;
funcInfo: DebugInfo;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
funcInfo := f.functionsInfo[lineIndex];
f.disassemblerPosition := funcInfo.getAddress();
f.paintGUIElement(f.guiDisassembler);
end;
function GUIElementAllFunctions.getLinesCount(): int;
begin
result := length(TDisassemblerForm_self.functionsInfo);
end;
{%endregion}
{%region GUIElementExceptions }
constructor GUIElementExceptions.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self, box, scroll);
end;
procedure GUIElementExceptions.paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean);
var
f: TDisassemblerForm;
intArray: PIntArray;
intnum: int;
s: AnsiString;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
canvas.brush.style := bsClear;
canvas.font.style := [];
intnum := (lineIndex shr 1) and $ff;
intArray := PIntArray(f.processor.getMemory(MalikProcessor.MEMORY_START + (lineIndex * sizeof(int)), sizeof(int)));
if intArray = nil then begin
exit;
end;
if (lineIndex and 1) = 0 then begin
if highlighted then begin
canvas.font.color := clHighlightText;
end else begin
canvas.font.color := f.colorNormalData;
end;
s := HEX_DIGITS[(intnum shr $4) + 1] + HEX_DIGITS[(intnum and $f) + 1];
canvas.textOut(left, top, s);
if highlighted then begin
canvas.font.color := clHighlightText;
end else begin
canvas.font.color := f.colorFunctionName;
end;
s := f.getAddressRepresentation(intArray[0]);
canvas.textOut(left + 32, top, s);
end else begin
if highlighted then begin
canvas.font.color := clHighlightText;
end else begin
canvas.font.color := f.colorObjectData;
end;
s := TDisassemblerForm.DATA_REPRESENTER.getObjectRepresentation(intArray[0]);
canvas.textOut(left + 32, top, s);
end;
end;
procedure GUIElementExceptions.paint(canvas: TCanvas; width, height, scrollPosition: int);
begin
if TDisassemblerForm_self.owner.isNowDebugging() then begin
inherited paint(canvas, width, height, scrollPosition);
end;
end;
procedure GUIElementExceptions.lineClicked(lineIndex: int; auxButton: boolean);
var
f: TDisassemblerForm;
intArray: PIntArray;
intnum: int;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
intnum := lineIndex shr 1;
if (lineIndex and 1) = 0 then begin
intArray := PIntArray(f.processor.getMemory(MalikProcessor.MEMORY_START + (intnum shl 3), sizeof(int)));
if intArray = nil then begin
exit;
end;
f.disassemblerPosition := intArray[0];
f.guiDisassembler.repaint();
end else begin
f.addDebugInspectorElement('Обработчик прерывания ' + TDisassemblerForm.DATA_REPRESENTER.getHexRepresentation(intnum), SIGNATURE_OBJECT, MalikProcessor.MEMORY_START + (intnum shl 3) + sizeof(int));
end;
end;
function GUIElementExceptions.getLinesCount(): int;
begin
result := $200;
end;
{%endregion}
{%region GUIElementBreakpoints }
constructor GUIElementBreakpoints.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self, box, scroll);
end;
procedure GUIElementBreakpoints.paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean);
var
f: TDisassemblerForm;
begin
canvas.brush.style := bsClear;
canvas.font.style := [];
f := TDisassemblerForm_self;
if highlighted then begin
canvas.font.color := clHighlightText;
end else begin
canvas.font.color := f.colorNormalData;
end;
canvas.textOut(left + 32, top, f.getAddressRepresentation(f.breakpoints[lineIndex]));
end;
procedure GUIElementBreakpoints.lineClicked(lineIndex: int; auxButton: boolean);
var
f: TDisassemblerForm;
b: int_Array1d;
i: int;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
b := f.breakpoints;
if auxButton then begin
for i := lineIndex to f.breakpointsCount - 2 do begin
b[i] := b[i + 1];
end;
dec(f.breakpointsCount);
repaint();
end else begin
f.disassemblerPosition := b[lineIndex];
end;
f.guiDisassembler.repaint();
end;
function GUIElementBreakpoints.getLinesCount(): int;
begin
result := TDisassemblerForm_self.breakpointsCount;
end;
{%endregion}
{%region GUIElementContext }
constructor GUIElementContext.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self, box, scroll);
end;
procedure GUIElementContext.paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean);
var
f: TDisassemblerForm;
r: Representer;
ctx: MalikDebugContext;
s: AnsiString;
begin
canvas.brush.style := bsClear;
canvas.font.style := [];
f := TDisassemblerForm_self;
if highlighted then begin
canvas.font.color := clHighlightText;
end else begin
canvas.font.color := f.colorNormalData;
end;
r := TDisassemblerForm.DATA_REPRESENTER;
ctx := f.currentContext;
case lineIndex of
0: begin
s := 'EIP ' + r.getHexRepresentation(ctx.regEIP);
end;
1: begin
s := 'ESP ' + r.getHexRepresentation(ctx.regESP);
end;
2: begin
s := 'EBP ' + r.getHexRepresentation(ctx.regEBP);
end;
3: begin
s := 'S.LIM ' + r.getHexRepresentation(ctx.stackBegin);
end;
4: begin
s := 'S.BOT ' + r.getHexRepresentation(ctx.stackEnd);
end;
5: begin
s := 'IF ' + toDecString(ctx.regIF);
end;
6: begin
case ctx.state of
CONTEXT_STATE_NOEXECUTE:
s := 'STATE NO EXECUTE';
CONTEXT_STATE_ACTIVE:
s := 'STATE ACTIVE';
CONTEXT_STATE_PAUSED:
s := 'STATE PAUSED';
CONTEXT_STATE_WAITING:
s := 'STATE WAITING';
else
s := '';
end;
end;
7: begin
s := 'L.CNT ' + toDecString(ctx.lockedCount);
end;
8: begin
s := 'N.ID ' + toDecString(ctx.nextID);
end;
else
s := '';
end;
canvas.textOut(left + 32, top, s);
end;
procedure GUIElementContext.paint(canvas: TCanvas; width, height, scrollPosition: int);
begin
if TDisassemblerForm_self.owner.isNowDebugging() then begin
inherited paint(canvas, width, height, scrollPosition);
end;
end;
procedure GUIElementContext.lineClicked(lineIndex: int; auxButton: boolean);
var
f: TDisassemblerForm;
ctx: MalikDebugContext;
funcInfo: DebugInfo;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
ctx := f.currentContext;
case lineIndex of
0: begin
if auxButton then begin
funcInfo := f.getFunctionAt(ctx.regEIP);
if funcInfo <> nil then begin
f.disassemblerPosition := funcInfo.getAddress();
end else begin
f.disassemblerPosition := ctx.regEIP;
end;
end else begin
f.disassemblerPosition := ctx.regEIP;
end;
f.guiDisassembler.repaint();
end;
1.. 2: begin
f.stackPages.pages[0].show();
f.stackScrollbar.position := ((ctx.regESP - ctx.stackBegin) div sizeof(StackItem)) - 8;
f.guiStack[0].repaint();
end;
end;
end;
function GUIElementContext.getLinesCount(): int;
begin
result := 9;
end;
{%endregion}
{%region GUIElementStack }
constructor GUIElementStack.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self, box, scroll);
end;
procedure GUIElementStack.paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean);
var
f: TDisassemblerForm;
item: PStackItem;
r: Representer;
w: int;
valueColor: int;
typeColor: int;
valueRepresentation: AnsiString;
typeRepresentation: AnsiString;
s: AnsiString;
begin
f := TDisassemblerForm_self;
r := TDisassemblerForm.DATA_REPRESENTER;
item := PStackItem(f.processor.getMemory(f.currentContext.stackBegin + lineIndex * sizeof(StackItem), sizeof(StackItem)));
if item = nil then begin
exit;
end;
canvas.brush.style := bsClear;
canvas.font.style := [];
if highlighted then begin
valueColor := clHighlightText;
typeColor := clHighlightText;
end else begin
case item.itemType of
STACKITEM_FLOAT, STACKITEM_DOUBLE, STACKITEM_REAL,
STACKITEM_INT, STACKITEM_LONG: begin
valueColor := f.colorNormalData;
typeColor := f.colorNormalType;
end;
STACKITEM_OBJECT: begin
valueColor := f.colorObjectData;
typeColor := f.colorObjectType;
end;
STACKITEM_OVERFLOW: begin
valueColor := f.colorObjectData;
typeColor := f.colorOverflowType;
end;
STACKITEM_EXCEPT: begin
valueColor := f.colorExceptData;
typeColor := f.colorExceptType;
end;
STACKITEM_OLDEBP: begin
valueColor := f.colorOldEBPData;
typeColor := f.colorOldEBPType;
end;
STACKITEM_RETURN: begin
valueColor := f.colorReturnData;
typeColor := f.colorReturnType;
end;
STACKITEM_IRETURN: begin
valueColor := f.colorIReturnData;
typeColor := f.colorIReturnType;
end;
else
valueColor := f.colorEmptyData;
typeColor := f.colorEmptyData;
end;
end;
case item.itemType of
STACKITEM_INT: begin
valueRepresentation := r.getLongRepresentation(item.valueInt, DATA_TYPE_INT);
typeRepresentation := 'int';
end;
STACKITEM_LONG: begin
valueRepresentation := r.getLongRepresentation(item.valueLong, DATA_TYPE_LONG);
typeRepresentation := 'long';
end;
STACKITEM_FLOAT: begin
valueRepresentation := r.getFloatRepresentation(item.valueFloat);
typeRepresentation := 'float';
end;
STACKITEM_DOUBLE: begin
valueRepresentation := r.getDoubleRepresentation(item.valueDouble);
typeRepresentation := 'double';
end;
STACKITEM_REAL: begin
valueRepresentation := r.getRealRepresentation(item.valueReal, item.valueRealFrom);
typeRepresentation := 'real';
end;
STACKITEM_OBJECT: begin
valueRepresentation := r.getObjectRepresentation(item.valueObject);
typeRepresentation := 'object';
end;
STACKITEM_OVERFLOW: begin
valueRepresentation := r.getObjectRepresentation(item.valueObject);
typeRepresentation := 'overflow';
end;
STACKITEM_EXCEPT: begin
valueRepresentation := 'EIP=' + r.getHexRepresentation(item.handlerEIP) + ' EBP=' + r.getHexRepresentation(item.handlerEBP) + ' IF=' + toDecString(item.handlerIF);
typeRepresentation := 'except';
end;
STACKITEM_OLDEBP: begin
valueRepresentation := r.getHexRepresentation(item.oldEBP);
typeRepresentation := 'oldebp';
end;
STACKITEM_RETURN: begin
valueRepresentation := r.getHexRepresentation(item.returnEIP);
typeRepresentation := 'return';
end;
STACKITEM_IRETURN: begin
valueRepresentation := r.getHexRepresentation(item.returnEIP) + ' IF=' + toDecString(byte(item.ireturnIF));
typeRepresentation := 'ireturn';
end;
else
valueRepresentation := r.getUntypedValueRepresentation();
typeRepresentation := '';
end;
s := toUTF16String(valueRepresentation);
w := width - canvas.textWidth(typeRepresentation) - 32;
while (length(s) > 2) and (canvas.textWidth(toUTF8String(s)) > w) do begin
s := copy(s, 1, length(s) - 2) + #$2026;
{ $2026 – код символа многоточия («…») }
end;
valueRepresentation := toUTF8String(s);
canvas.font.color := valueColor;
canvas.textOut(left + 32, top, valueRepresentation);
canvas.font.color := typeColor;
canvas.textOut(left + w + 32, top, typeRepresentation);
end;
procedure GUIElementStack.paint(canvas: TCanvas; width, height, scrollPosition: int);
var
f: TDisassemblerForm;
ctx: MalikDebugContext;
h: int;
ih: int;
lastIndex: int;
espIndex: int;
ebpIndex: int;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
inherited paint(canvas, width, height, scrollPosition);
h := abs(canvas.font.height);
if h = 0 then begin
exit;
end;
ctx := f.currentContext;
lastIndex := scrollPosition + (height div h);
if (height mod h) > 0 then begin
inc(lastIndex);
end;
espIndex := (ctx.regESP - ctx.stackBegin) div sizeof(StackItem);
ebpIndex := (ctx.regEBP - ctx.stackBegin) div sizeof(StackItem);
if (ebpIndex >= scrollPosition) and (ebpIndex < lastIndex) then begin
ih := (ebpIndex - scrollPosition) * h;
canvas.pen.style := psSolid;
canvas.pen.width := 1;
canvas.pen.color := $ffa040;
canvas.moveTo(32, ih + 1);
canvas.lineTo(width, ih + 1);
canvas.moveTo(32, ih + h + 1);
canvas.lineTo(width, ih + h + 1);
f.arrows.draw(canvas, 32 - f.arrows.width, ih + ((h - f.arrows.height) div 2) + 1, 2);
end;
if (espIndex >= scrollPosition) and (espIndex < lastIndex) and (espIndex <> ebpIndex) then begin
ih := (espIndex - scrollPosition) * h;
canvas.pen.style := psSolid;
canvas.pen.width := 1;
canvas.pen.color := $40a0ff;
canvas.moveTo(32, ih + 1);
canvas.lineTo(width, ih + 1);
canvas.moveTo(32, ih + h + 1);
canvas.lineTo(width, ih + h + 1);
f.arrows.draw(canvas, 32 - f.arrows.width, ih + ((h - f.arrows.height) div 2) + 1, 0);
end;
end;
procedure GUIElementStack.lineClicked(lineIndex: int; auxButton: boolean);
var
f: TDisassemblerForm;
r: Representer;
item: PStackItem;
funcInfo: DebugInfo;
address: int;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
r := TDisassemblerForm.DATA_REPRESENTER;
address := f.currentContext.stackBegin + lineIndex * sizeof(StackItem);
item := PStackItem(f.processor.getMemory(address, sizeof(StackItem)));
if item = nil then begin
exit;
end;
case item.itemType of
STACKITEM_INT: begin
f.addDebugInspectorElement(r.getHexRepresentation(address), SIGNATURE_INT, address);
end;
STACKITEM_LONG: begin
f.addDebugInspectorElement(r.getHexRepresentation(address), SIGNATURE_LONG, address);
end;
STACKITEM_FLOAT: begin
f.addDebugInspectorElement(r.getHexRepresentation(address), SIGNATURE_FLOAT, address);
end;
STACKITEM_DOUBLE: begin
f.addDebugInspectorElement(r.getHexRepresentation(address), SIGNATURE_DOUBLE, address);
end;
STACKITEM_REAL: begin
f.addDebugInspectorElement(r.getHexRepresentation(address), SIGNATURE_REAL, address);
end;
STACKITEM_OBJECT, STACKITEM_OVERFLOW: begin
f.addDebugInspectorElement(r.getHexRepresentation(address), SIGNATURE_OBJECT, address);
end;
STACKITEM_EXCEPT: begin
if auxButton then begin
funcInfo := f.getFunctionAt(item.handlerEIP);
if funcInfo <> nil then begin
f.disassemblerPosition := funcInfo.getAddress();
end else begin
f.disassemblerPosition := item.handlerEIP;
end;
end else begin
f.disassemblerPosition := item.handlerEIP;
end;
f.guiDisassembler.repaint();
end;
STACKITEM_RETURN, STACKITEM_IRETURN: begin
if auxButton then begin
funcInfo := f.getFunctionAt(item.returnEIP);
if funcInfo <> nil then begin
f.disassemblerPosition := funcInfo.getAddress();
end else begin
f.disassemblerPosition := item.returnEIP;
end;
end else begin
f.disassemblerPosition := item.returnEIP;
end;
f.guiDisassembler.repaint();
end;
end;
end;
function GUIElementStack.getLinesCount(): int;
var
ctx: MalikDebugContext;
begin
ctx := TDisassemblerForm_self.currentContext;
result := (ctx.stackEnd - ctx.stackBegin) div sizeof(StackItem);
end;
{%endregion}
{%region GUIElementCallStack }
constructor GUIElementCallStack.create(TDisassemblerForm_self: TDisassemblerForm; box: TPaintBox; scroll: TScrollBar);
begin
inherited create(TDisassemblerForm_self, box, scroll);
end;
procedure GUIElementCallStack.paintLine(canvas: TCanvas; left, top, width, height, lineIndex: int; highlighted: boolean);
var
f: TDisassemblerForm;
s: AnsiString;
begin
canvas.brush.style := bsClear;
canvas.font.style := [];
f := TDisassemblerForm_self;
if highlighted then begin
canvas.font.color := clHighlightText;
end else begin
canvas.font.color := f.colorNormalData;
end;
s := f.getAddressRepresentation(addresses[lineIndex]);
canvas.textOut(left + 32, top, s);
end;
procedure GUIElementCallStack.paint(canvas: TCanvas; width, height, scrollPosition: int);
begin
if TDisassemblerForm_self.owner.isNowDebugging() then begin
inherited paint(canvas, width, height, scrollPosition);
end;
end;
procedure GUIElementCallStack.lineClicked(lineIndex: int; auxButton: boolean);
var
f: TDisassemblerForm;
funcInfo: DebugInfo;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
exit;
end;
if auxButton then begin
funcInfo := f.getFunctionAt(addresses[lineIndex]);
if funcInfo <> nil then begin
f.disassemblerPosition := funcInfo.getAddress();
end else begin
f.disassemblerPosition := addresses[lineIndex];
end;
end else begin
f.disassemblerPosition := addresses[lineIndex];
end;
f.guiDisassembler.repaint();
end;
function GUIElementCallStack.getLinesCount(): int;
var
f: TDisassemblerForm;
p: MalikProcessor;
ctx: MalikDebugContext;
item: PStackItem;
c: int;
a: int;
begin
f := TDisassemblerForm_self;
if not f.owner.isNowDebugging() then begin
result := length(addresses);
exit;
end;
p := f.processor;
ctx := f.currentContext;
c := 1;
a := ctx.regESP;
while a < ctx.stackEnd do begin
item := PStackItem(p.getMemory(a, sizeof(StackItem)));
if (item.itemType = STACKITEM_RETURN) or (item.itemType = STACKITEM_IRETURN) then begin
inc(c);
end;
inc(a, sizeof(StackItem));
end;
addresses := int_Array1d_create(c);
addresses[0] := ctx.regEIP;
c := 1;
a := ctx.regESP;
while a < ctx.stackEnd do begin
item := PStackItem(p.getMemory(a, sizeof(StackItem)));
if (item.itemType = STACKITEM_RETURN) or (item.itemType = STACKITEM_IRETURN) then begin
addresses[c] := item.returnEIP;
inc(c);
end;
inc(a, sizeof(StackItem));
end;
result := c;
end;
{%endregion}
initialization {%region}
TDisassemblerForm.clinit();
{%endregion}
finalization {%region}
TDisassemblerForm.cldone();
{%endregion}
end.
