unit Simx86p;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Patterns, Menus, StdCtrls, TabNotBk, ExtCtrls, VBXCtrl,
Switch, Spin, GetInput, Printers;
type
TMem = array [0..$ffef] of byte;
TMemPtr = ^TMem;
TSIMx86Form = class(TForm)
Simx86Pages: TTabbedNotebook;
SourceCode: TMemo;
MainMenu: TMainMenu;
File1: TMenuItem;
Edit: TMenuItem;
New: TMenuItem;
Open: TMenuItem;
Save: TMenuItem;
SaveAs: TMenuItem;
Cut: TMenuItem;
Copy: TMenuItem;
Paste: TMenuItem;
Delete: TMenuItem;
EditBreak: TMenuItem;
BeforeQuit: TMenuItem;
PrintMenuItem: TMenuItem;
SelectAll: TMenuItem;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
StartAdrs: TEdit;
StartAdrsLbl: TLabel;
ASMbtn: TButton;
Mem01: TEdit;
Mem02: TEdit;
Mem03: TEdit;
Mem04: TEdit;
Mem05: TEdit;
Mem00: TEdit;
Mem06: TEdit;
Mem07: TEdit;
AdrsEntry: TEdit;
Label0: TLabel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Lbl8: TLabel;
Lbl10: TLabel;
Lbl18: TLabel;
Lbl20: TLabel;
Lbl28: TLabel;
Lbl30: TLabel;
Lbl38: TLabel;
Mem10: TEdit;
Mem11: TEdit;
Mem12: TEdit;
Mem13: TEdit;
Mem14: TEdit;
Mem15: TEdit;
Mem16: TEdit;
Mem17: TEdit;
Mem27: TEdit;
Mem26: TEdit;
Mem25: TEdit;
Mem24: TEdit;
Mem23: TEdit;
Mem22: TEdit;
Mem21: TEdit;
Mem20: TEdit;
Mem30: TEdit;
Mem31: TEdit;
Mem32: TEdit;
Mem33: TEdit;
Mem34: TEdit;
Mem35: TEdit;
Mem36: TEdit;
Mem37: TEdit;
Mem47: TEdit;
Mem46: TEdit;
Mem45: TEdit;
Mem44: TEdit;
Mem43: TEdit;
Mem42: TEdit;
Mem41: TEdit;
Mem40: TEdit;
Mem50: TEdit;
Mem51: TEdit;
Mem52: TEdit;
Mem53: TEdit;
Mem54: TEdit;
Mem55: TEdit;
Mem56: TEdit;
Mem57: TEdit;
Mem67: TEdit;
Mem66: TEdit;
Mem65: TEdit;
Mem64: TEdit;
Mem63: TEdit;
Mem62: TEdit;
Mem61: TEdit;
Mem60: TEdit;
Mem70: TEdit;
Mem71: TEdit;
Mem72: TEdit;
Mem73: TEdit;
Mem74: TEdit;
Mem75: TEdit;
Mem76: TEdit;
Mem77: TEdit;
IntVect: TEdit;
IntVectLbl: TLabel;
ResetVectLbl: TLabel;
ResetVect: TEdit;
Label8: TLabel;
DisAsm: TListBox;
Output: TListBox;
InPort0: TBiSwitch;
InPort2: TBiSwitch;
InPort4: TBiSwitch;
InPort6: TBiSwitch;
OutPort8: TShape;
OutPortA: TShape;
OutPortC: TShape;
OutPortE: TShape;
FFF8Lbl: TLabel;
FFFALbl: TLabel;
FFFCLbl: TLabel;
FFFELbl: TLabel;
RunBtn: TButton;
StepBtn: TButton;
HaltBtn: TButton;
InterruptBtn: TButton;
OutputLbl: TLabel;
RunningLite: TPanel;
AXValue: TEdit;
AXLbl: TLabel;
BXValue: TEdit;
DXValue: TEdit;
CXValue: TEdit;
IPValue: TEdit;
BXLbl: TLabel;
CXLbl: TLabel;
DXLbl: TLabel;
IPLbl: TLabel;
Instruction: TLabel;
DisAsmAdrs: TEdit;
EqualFlag: TCheckBox;
LessThanFlag: TCheckBox;
ResetBtn: TButton;
Input: TListBox;
InputLbl: TLabel;
SpinButton: TSpinButton;
ClrMemBtn: TButton;
PrintDialog: TPrintDialog;
N1: TMenuItem;
Quit: TMenuItem;
procedure QuitClick(Sender: TObject);
procedure CutClick(Sender: TObject);
procedure CopyClick(Sender: TObject);
procedure PasteClick(Sender: TObject);
procedure DeleteClick(Sender: TObject);
procedure SelectAllClick(Sender: TObject);
procedure NewClick(Sender: TObject);
procedure OpenClick(Sender: TObject);
procedure SaveAsClick(Sender: TObject);
procedure HexChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure AdrsEntryChange(Sender: TObject);
procedure StartAdrsChange(Sender: TObject);
procedure ASMbtnClick(Sender: TObject);
procedure Simx86PagesChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
procedure ClrMemBtnClick(Sender: TObject);
procedure DisAsmAdrsChange(Sender: TObject);
procedure SpinButtonDownClick(Sender: TObject);
procedure SpinButtonUpClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure RunBtnClick(Sender: TObject);
procedure HaltBtnClick(Sender: TObject);
procedure InterruptBtnClick(Sender: TObject);
procedure IntVectChange(Sender: TObject);
procedure IPValueChange(Sender: TObject);
procedure StepBtnClick(Sender: TObject);
procedure PrintMenuItemClick(Sender: TObject);
procedure SaveClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
SIMx86Form: TSIMx86Form;
MemEntry: array[0..7,0..7] of TEdit;
implementation
type
TSymPtr = ^TSym;
TSym = record
value:word;
defined:boolean;
end;
const
MaxCodeAdrs = 4095;
var
HasOpcode:Boolean;
Opcode:word;
HasReg:Boolean;
RegCode:word;
HasOperand:Boolean;
OperandCode:word;
HasValue:Boolean;
OperandValue:word;
StoreMem:boolean;
Halted:boolean;
Running:boolean;
PendingInt:boolean;
InInt:boolean;
IntAdrs:word;
Val:byte;
AX: word;
BX: word;
CX: word;
DX: word;
IP: word;
LineNum:integer;
Adrs:word;
MemAdrs:word;
MemWS:integer;
AbortAsm:Boolean;
NoError:Boolean;
Memory: TMemPtr;
SymTbl: array ['A'..'Z'] of TSym;
SaveAX:word;
SaveBX:word;
SaveCX:word;
SaveDX:word;
SaveIP:word;
SaveEqual:boolean;
SaveLess:boolean;
Reg:byte;
RegMem:byte;
Operation:byte;
InstrSize:word;
Op1:^word;
Op2v:word;
offset:word;
Filename:string;
{$F+}
function ProcessLbl(Pat:TPatPtr):boolean; forward;
function GetLbl(Pat:TPatPtr):boolean; forward;
function ConvertHex(Pat:TPatPtr):boolean; forward;
procedure SetJmp(Pat:TPatPtr); forward;
procedure SetJa(Pat:TPatPtr); forward;
procedure SetJae(Pat:TPatPtr); forward;
procedure SetJb(Pat:TPatPtr); forward;
procedure SetJbe(Pat:TPatPtr); forward;
procedure SetJe(Pat:TPatPtr); forward;
procedure SetJne(Pat:TPatPtr); forward;
procedure SetNot(Pat:TPatPtr); forward;
procedure SetAnd(Pat:TPatPtr); forward;
procedure SetOr(Pat:TPatPtr); forward;
procedure SetCmp(Pat:TPatPtr); forward;
procedure SetSub(Pat:TPatPtr); forward;
procedure SetAdd(Pat:TPatPtr); forward;
procedure SetMovReg(Pat:TPatPtr); forward;
procedure SetMovMem(Pat:TPatPtr); forward;
procedure SetIret(Pat:TPatPtr); forward;
procedure SetHalt(Pat:TPatPtr); forward;
procedure SetBrk(Pat:TPatPtr); forward;
procedure SetPut(Pat:TPatPtr); forward;
procedure SetGet(Pat:TPatPtr); forward;
procedure SetAX(Pat:TPatPtr); forward;
procedure SetBX(Pat:TPatPtr); forward;
procedure SetCX(Pat:TPatPtr); forward;
procedure SetDX(Pat:TPatPtr); forward;
procedure SetAX2(Pat:TPatPtr); forward;
procedure SetBX2(Pat:TPatPtr); forward;
procedure SetCX2(Pat:TPatPtr); forward;
procedure SetDX2(Pat:TPatPtr); forward;
procedure SetBXInd(Pat:TPatPtr); forward;
procedure SetBXIndx(Pat:TPatPtr); forward;
procedure SetABS(Pat:TPatPtr); forward;
procedure SetImm(Pat:TPatPtr); forward;
{$F-}
const
{ WS1- Matches a string containing one or more white- }
{ space characters. }
WS1:TPattern = (mf:OneOrMoreCset; m:(cset:[' ',#9]);
Next:NIL; Alt:NIL; Success:NIL);
{ WS0- Matches a string containing zero or more white- }
{ space characters. }
WS0:TPattern=(mf:SpanCset; m:(cset:[' ',#9]);
Next:NIL; Alt:NIL; Success:NIL);
{ A Pattern that matches whitespace at the end of a line }
SkipToEOS:TPattern=(mf:EOS; m:(ch:' ');
Next:NIL; Alt:NIL; Success:NIL);
WSeoln:TPattern=(mf:SpanCset; m:(cset:[' ',#9]);
Next:@SkipToEOS; Alt:NIL; Success:NIL);
{ Match an x86 register mode here. }
TryDX:Tpattern=(mf:Matchistr; m:(str:'DX');
Next:NIL; Alt:NIL; Success:SetDX);
TryCX:Tpattern=(mf:Matchistr; m:(str:'CX');
Next:NIL; Alt:@TryDX; Success:SetCX);
TryBX:Tpattern=(mf:Matchistr; m:(str:'BX');
Next:NIL; Alt:@TryCX; Success:SetBX);
TryReg:Tpattern=(mf:Matchistr; m:(str:'AX');
Next:NIL; Alt:@TryBX; Success:SetAX);
{ Match an x86 addressing mode here }
TryImm:TPattern=( mf:ConvertHex; m:(ch:' ');
Next:@WSEoln; Alt:NIL; Success:SetImm);
TryDX2:Tpattern=(mf:Matchistr; m:(str:'DX');
Next:@WSeoln; Alt:@TryImm; Success:SetDX2);
TryCX2:Tpattern=(mf:Matchistr; m:(str:'CX');
Next:@WSeoln; Alt:@TryDX2; Success:SetCX2);
TryBX2:Tpattern=(mf:Matchistr; m:(str:'BX');
Next:@WSeoln; Alt:@TryCX2; Success:SetBX2);
TryReg2:Tpattern=(mf:Matchistr; m:(str:'AX');
Next:@WSeoln; Alt:@TryBX2; Success:SetAX2);
BXBrack:TPattern=( mf:MatchChar; m:(ch:']');
Next:NIL; Alt:NIL; Success:NIL);
BXBrackWS:TPattern=( mf:SpanCset; m:(cset:[' ',#9]);
Next:@BXBrack; Alt:NIL; Success:NIL);
BXEnd:TPattern=( mf:MatchiStr; m:(str:'BX');
Next:@BXBrackWS; Alt:NIL; Success:NIL);
TryABS:TPattern=( mf:Succeed; m:(ch:' ');
Next:@BXBrackWS; Alt:NIL; Success:SetABS);
BXPlus:TPattern=( mf:MatchChar; m:(ch:'+');
Next:@BXEnd; Alt:@TryABS; Success:SetBXIndx);
BXPlusWS:TPattern=( mf:SpanCset; m:(cset:[' ',#9]);
Next:@BXPlus; Alt:NIL; Success:NIL);
BXIndex:TPattern=( mf:ConvertHex; m:(ch:' ');
Next:@BXPlusWS; Alt:@BXEnd; Success:NIL);
BXBracket:TPattern=( mf:MatchiStr; m:(str:'BX');
Next:@BXBrackWS; Alt:@BXIndex; Success:SetBXInd);
BXIndWS:TPattern=(mf:SpanCset; m:(cset:[' ',#9]);
Next:@BXBracket; Alt:NIL; Success:NIL);
DoMem:TPattern=( mf:MatchChar; m:(ch:'[');
Next:@BXIndWS; Alt:@TryReg2; Success:NIL);
{ Generic Two-operand instructions }
TryOr:TPattern=(mf:MatchiStr; m:(str:'OR');
Next:NIL; Alt:NIL; Success:SetOr);
TryAnd:TPattern=(mf:MatchiStr; m:(str:'AND');
Next:NIL; Alt:@TryOr; Success:SetAnd);
TryCmp:TPattern=(mf:MatchiStr; m:(str:'CMP');
Next:NIL; Alt:@TryAnd; Success:SetCmp);
TrySub:TPattern=(mf:MatchiStr; m:(str:'SUB');
Next:NIL; Alt:@TryCmp; Success:SetSub);
TryAdd:TPattern=( mf:MatchiStr; m:(str:'ADD');
Next:NIL; Alt:@TrySub; Success:SetAdd);
{ Handle label definitions at the beginning of the line }
Lbl:TPattern=(mf:ProcessLbl; m:(ch:' ');
Next:NIL; Alt:NIL; Success:NIL);
{ A statement may be one of the following: }
{ }
{ 1: A Blank Line. }
{ 2: An optional label in column 1 followed by an }
{ instruction. }
{ 3: Whitespace followed by an instruction. }
{ 4: An instruction starting in column 1. }
{ }
{ The following patterns match one of the above. }
{ Zero-Operand Instructions here: }
TryBrk:TPattern=( mf:MatchiStr; m:(str:'BRK');
Next:@WSeoln; Alt:NIL; Success:SetBrk);
TryIRet:TPattern=( mf:MatchiStr; m:(str:'IRET');
Next:@WSeoln; Alt:@TryBrk; Success:SetIret);
TryHalt:TPattern=( mf:MatchiStr; m:(str:'HALT');
Next:@WSeoln; Alt:@TryIRet; Success:SetHalt);
TryPut:TPattern=( mf:MatchiStr; m:(str:'PUT');
Next:@WSeoln; Alt:@TryHalt; Success:SetPut);
TryGet:TPattern=( mf:MatchiStr; m:(str:'GET');
Next:@WSeoln; Alt:@TryPut; Success:SetGet);
{ Jump Instructions here: }
JmpLbl2:TPattern=(mf:GetLbl; m:(ch:' ');
Next:NIL; Alt:NIL; Success:NIL);
JmpLbl:TPattern=(mf:OneOrMoreCset; m:(cset:[' ',#9]);
Next:@JmpLbl2; Alt:NIL; Success:NIL);
TryJne:TPattern=(mf:MatchiStr; m:(str:'JNE');
Next:@JmpLbl; Alt:@TryGet; Success:SetJne);
TryJe:TPattern=(mf:MatchiStr; m:(str:'JE');
Next:@JmpLbl; Alt:@TryJne; Success:SetJe);
TryJb:TPattern=(mf:MatchiStr; m:(str:'JB');
Next:@JmpLbl; Alt:@TryJe; Success:SetJb);
TryJbe:TPattern=(mf:MatchiStr; m:(str:'JBE');
Next:@JmpLbl; Alt:@TryJb; Success:SetJbe);
TryJa:TPattern=(mf:MatchiStr; m:(str:'JA');
Next:@JmpLbl; Alt:@TryJbe; Success:SetJa);
TryJae:TPattern=(mf:MatchiStr; m:(str:'JAE');
Next:@JmpLbl; Alt:@TryJa; Success:SetJae);
TryJmp:TPattern=(mf:MatchiStr; m:(str:'JMP');
Next:@JmpLbl; Alt:@TryJae; Success:SetJmp);
{ not reg/mem here: }
GenMemMode:TPattern=( mf:MatchSub; m:(Pat:@DoMem);
Next:@WSeoln; Alt:NIL; Success:NIL);
NotWS:TPattern=(mf:SpanCset; m:(cset:[' ',#9]);
Next:@GenMemMode; Alt:NIL; Success:NIL);
TryNotInstr:TPattern=( mf:MatchiStr; m:(str:'NOT');
Next:@NotWS; Alt:@TryJmp; Success:SetNot);
{ instr reg, mem here: }
WSComma2:TPattern=( mf:SpanCset; m:(cset:[' ',',',#9]);
Next:@GenMemMode; Alt:NIL; Success:NIL);
GenRegMem:TPattern=(mf:MatchSub; m:(Pat:@TryReg);
Next:@WSComma2; Alt:NIL; Success:NIL);
InstrWS:TPattern=(mf:SpanCset; m:(cset:[' ',#9]);
Next:@GenRegMem; Alt:NIL; Success:NIL);
TryGeneric:TPattern=( mf:MatchSub; m:(Pat:@TryAdd);
Next:@InstrWS; Alt:@TryNotInstr; Success:NIL);
{ mov mem, reg here: }
MovReg:TPattern=(mf:MatchSub; m:(Pat:@TryReg);
Next:@WSeoln; Alt:NIL; Success:SetMovMem);
WSComma3:TPattern=( mf:SpanCset; m:(cset:[' ',',',#9]);
Next:@MovReg; Alt:NIL; Success:NIL);
MemReg:TPattern=( mf:MatchSub; m:(Pat:@DoMem);
Next:@WSComma3; Alt:NIL; Success:NIL);
{ mov reg, mem here: }
MemMode:TPattern=( mf:MatchSub; m:(Pat:@DoMem);
Next:@WSeoln; Alt:NIL; Success:SetMovReg);
WSComma:TPattern=( mf:SpanCset; m:(cset:[' ',',',#9]);
Next:@MemMode; Alt:NIL; Success:NIL);
RgMem:TPattern=(mf:MatchSub; m:(Pat:@TryReg);
Next:@WSComma; Alt:@MemReg; Success:NIL);
{ Generic mov here: }
MovWS:TPattern=(mf:SpanCset; m:(cset:[' ',#9]);
Next:@RgMem; Alt:NIL; Success:NIL);
TryMnemonic:TPattern=(mf:MatchiStr; m:(str:'MOV');
Next:@MovWS; Alt:@TryGeneric; Success:NIL);
TryEOS:TPattern=(mf:EOS; m:(ch:' ');
Next:NIL; Alt:@TryMnemonic; Success:NIL);
TryWS:TPattern =(mf:SpanCset; m:(cset:[' ',#9]);
Next:@TryEOS; Alt:NIL; Success:NIL);
stmt:TPattern = (mf:MatchSub; m:(Pat:@Lbl);
Next:@TryMnemonic; Alt:@TryWS; Success:NIL);
{ System initialization }
procedure TSIMx86Form.FormCreate(Sender: TObject);
var i: word;
ch: char;
begin
{ Allocate Storage for the x86 memory space }
system.new(Memory);
{ Zero out the allocated memory }
for i := 0 to $ffef do
Memory^[i] := 0;
MemAdrs := 0;
MemWS := 0;
IntAdrs := $FFFF;
Adrs := 0;
AX := 0;
BX := 0;
CX := 0;
DX := 0;
IP := 0;
MemEntry[0,0] := Mem00;
MemEntry[0,1] := Mem01;
MemEntry[0,2] := Mem02;
MemEntry[0,3] := Mem03;
MemEntry[0,4] := Mem04;
MemEntry[0,5] := Mem05;
MemEntry[0,6] := Mem06;
MemEntry[0,7] := Mem07;
MemEntry[1,0] := Mem10;
MemEntry[1,1] := Mem11;
MemEntry[1,2] := Mem12;
MemEntry[1,3] := Mem13;
MemEntry[1,4] := Mem14;
MemEntry[1,5] := Mem15;
MemEntry[1,6] := Mem16;
MemEntry[1,7] := Mem17;
MemEntry[2,0] := Mem20;
MemEntry[2,1] := Mem21;
MemEntry[2,2] := Mem22;
MemEntry[2,3] := Mem23;
MemEntry[2,4] := Mem24;
MemEntry[2,5] := Mem25;
MemEntry[2,6] := Mem26;
MemEntry[2,7] := Mem27;
MemEntry[3,0] := Mem30;
MemEntry[3,1] := Mem31;
MemEntry[3,2] := Mem32;
MemEntry[3,3] := Mem33;
MemEntry[3,4] := Mem34;
MemEntry[3,5] := Mem35;
MemEntry[3,6] := Mem36;
MemEntry[3,7] := Mem37;
MemEntry[4,0] := Mem40;
MemEntry[4,1] := Mem41;
MemEntry[4,2] := Mem42;
MemEntry[4,3] := Mem43;
MemEntry[4,4] := Mem44;
MemEntry[4,5] := Mem45;
MemEntry[4,6] := Mem46;
MemEntry[4,7] := Mem47;
MemEntry[5,0] := Mem50;
MemEntry[5,1] := Mem51;
MemEntry[5,2] := Mem52;
MemEntry[5,3] := Mem53;
MemEntry[5,4] := Mem54;
MemEntry[5,5] := Mem55;
MemEntry[5,6] := Mem56;
MemEntry[5,7] := Mem57;
MemEntry[6,0] := Mem60;
MemEntry[6,1] := Mem61;
MemEntry[6,2] := Mem62;
MemEntry[6,3] := Mem63;
MemEntry[6,4] := Mem64;
MemEntry[6,5] := Mem65;
MemEntry[6,6] := Mem66;
MemEntry[6,7] := Mem67;
MemEntry[7,0] := Mem70;
MemEntry[7,1] := Mem71;
MemEntry[7,2] := Mem72;
MemEntry[7,3] := Mem73;
MemEntry[7,4] := Mem74;
MemEntry[7,5] := Mem75;
MemEntry[7,6] := Mem76;
MemEntry[7,7] := Mem77;
{ See if there were any command-line parameters }
if (ParamCount = 1) then
begin
SourceCode.Lines.LoadFromFile(ParamStr(1));
Filename := ParamStr(1);
end
else Filename := '';
end;
(****************************************************************************)
{$R *.DFM}
{ Read a byte from memory. Also handles memory-mapped I/O (locations }
{ $FFF0.$FFFF are memory-mapped I/O locations). }
{ }
{ $FFF0 (bit 0)- Switch zero. }
{ $FFF2 (bit 0)- Switch one. }
{ $FFF4 (bit 0)- Switch two. }
{ $FFF6 (bit 0)- Switch three. }
{ All other bit positions return zero in the above words. }
{ }
{ Locations $FFF8..$FFFF are write-only locations and return }
{ random garbage. }
function ReadMem(adrs:word):byte;
begin
if (adrs < $fff0) then Result := Memory^[adrs]
else begin
with SIMx86Form do begin
if (Adrs = $fff0) then Result := ord(Inport0.pOn)
else if (Adrs = $fff2) then Result := ord(Inport2.pOn)
else if (Adrs = $fff4) then Result := ord(Inport4.pOn)
else if (Adrs = $fff6) then Result := ord(Inport6.pOn)
else if (Adrs = $fff1) or (Adrs=$FFF3) or
(Adrs = $fff5) or (Adrs=$fff7) then Result := 0;
end;
end;
end;
{ WriteMem- Write a byte to memory. Note that locations }
{ $FFF0..$FFFF are memory mapped I/O locations }
{ and must be handled specially. Only the low- }
{ order bit of locations $FFF8, $FFFA, $FFFC, and }
{ $FFFE are active outputs; these bits cor- }
{ respond to the four LEDs. The other memory- }
{ mapped I/O locations ignore data written to them}
procedure WriteMem(Adrs:word; Value:word);
begin
if (Adrs < $fff0) then
Memory^[Adrs] := Value
else begin
with SIMx86Form do begin
if (Adrs = $fff8) then
if (odd(Value)) then Outport8.Brush.Color := clRed
else Outport8.Brush.Color := clWhite
else if (Adrs = $fffa) then
if (odd(Value)) then OutportA.Brush.Color := clRed
else OutportA.Brush.Color := clWhite
else if (Adrs = $fffC) then
if (odd(Value)) then OutportC.Brush.Color := clRed
else OutportC.Brush.Color := clWhite
else if (Adrs = $fffe) then
if (odd(Value)) then OutportE.Brush.Color := clRed
else OutportE.Brush.Color := clWhite;
end;
end;
end;
{ Print an error message dialog box for the assembler. }
procedure ErrorMsg(const msg, Stmt:string);
begin
AbortAsm := MessageDlg(msg+': '+Stmt,
mtWarning,[mbOK, mbCancel],0) = mrCancel;
NoError := false;
end;
{ The following function converts a string of characters representing a }
{ hexadecimal number into the binary equivalent. }
function HexToWord(const s:string):word;
var i:integer;
begin
Result := 0;
for i := 1 to length(s) do
if (s[i] in ['0'..'9']) then
Result := (Result shl 4) + ord(s[i]) - ord('0')
else
Result := (Result shl 4) + ord(upcase(s[i])) -
ord('A') + 10;
end;
{ CheckHex- This procedure checks a TEdit object to see if its text }
{ field contains a valid hexadecimal value. It turns the }
{ background red if invalid. }
procedure CheckHex(var s:TEdit);
var i:integer;
begin
s.Color := clWindow;
for i := 1 to length(s.Text) do
if not (s.Text[i] in ['0'..'9','A'..'F','a'..'f']) then
begin
s.Color := clRed;
MessageBeep($FFFF);
end;
end;
{$F+}
{ Whenever the assembler encounters a label at the beginning of a line, }
{ the following function checks to see if it is a legal label and adds }
{ it to the symbol table along with its address. It also backpatches }
{ any previous references to that symbol if there are any. }
function ProcessLbl(Pat:TPatPtr):boolean;
var id: char;
i,
tmp:word;
begin
id :=upcase(Pat^.EndPattern^);
{ See if this is a legal label }
if (id in ['A'..'Z']) and ((Pat^.EndPattern+1)^ = ':') then
begin
{See if this symbol is already in the symbol table. }
if SymTbl[id].Defined then
begin
ErrorMsg('Duplicate Identifier',
SIMx86Form.SourceCode.lines[LineNum]);
end
else begin
{ See if this symbol was used already. }
{ If so, we need to backpatch some }
{ addresses in memory. }
if (SymTbl[id].Value <> 0) then
begin
i := SymTbl[id].Value;
repeat
tmp := Memory^[i] + (Memory^[i+1] shl 8);
Memory^[i] := Adrs and $ff;
Memory^[i+1] := Adrs shr 8;
i := tmp;
until i = 0;
end;
{ Put all the necessary information into the symbol table. }
SymTbl[id].Defined := true;
SymTbl[id].Value := adrs;
Result := true;
{ Skip over any white space following this label. }
Pat^.EndPattern := Pat^.EndPattern + 2;
While (Pat^.EndPattern^ in [' ',#9]) do
inc(Pat^.EndPattern);
end;
end
else Result := false;
end;
{ ConvertHex- Converts the text field of a PChar object into a binary }
{ value and return true if the result is successful. }
{ This routine shoves the binary result into the global }
{ variable OperandValue. The assembler uses this func }
{ to process hexadecimal instruction operands. }
function ConvertHex(Pat:TPatPtr):Boolean;
var i:integer;
begin
OperandValue := 0;
Result := Pat^.EndPattern^ in ['0'..'9', 'a'..'f', 'A'..'F'];
HasValue := true;
while (Pat^.EndPattern^ in ['0'..'9', 'a'..'f', 'A'..'F']) do
begin
if (Pat^.EndPattern^ in ['0'..'9']) then
OperandValue := (OperandValue shl 4) +
ord(Pat^.EndPattern^) - ord('0')
else
OperandValue := ( OperandValue shl 4) +
ord(upcase(Pat^.EndPattern^ )) -
ord('A') + 10;
inc(Pat^.EndPattern);
end;
end;
{ GetLbl- The assembler uses this function to process labels it }
{ finds in the operand field of a jump instruction. }
function GetLbl(Pat:TPatPtr):boolean;
var id:char;
begin
id :=upcase(Pat^.EndPattern^);
Result := false;
{ If the operand begins with a decimal digit, it's a hexadecimal }
{ number, not a label. }
if (id in ['0'..'9']) then
begin
HasValue := ConvertHex(Pat);
while (Pat^.EndPattern^ in [' ',#9]) do inc(Pat^.EndPattern);
Result := Pat^.EndPattern^ = #0;
end
{ If the operand begins with an alphabetic character, then we've }
{ got a label. }
else if (id in ['A'..'Z']) then
begin
HasValue := true;
if (not SymTbl[id].Defined) then
begin
{ If the symbol is not defined yet, create a linked }
{ list of undefined items for this symbol. }
OperandValue := SymTbl[id].Value;
SymTbl[id].Value := adrs+1;
end
else OperandValue := SymTbl[id].Value;
repeat
inc(Pat^.EndPattern);
until not (Pat^.EndPattern^ in [' ',#9]);
Result := Pat^.EndPattern^ = #0;
end
else begin
ErrorMsg('Expected label operand',
SIMx86Form.SourceCode.lines[LineNum]);
end;
end;
{ The assembler calls the following procedure whenever it encounters }
{ the corresponding procedure or operand. These procedures set up the }
{ global opcode and operand values so the assembler can emit the ap- }
{ propriate object code later. }
Procedure SetJmp(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $8;
HasOperand := true;
OperandCode := $6;
end;
Procedure SetJa(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $8;
HasOperand := true;
OperandCode := $4;
end;
Procedure SetJae(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $8;
HasOperand := true;
OperandCode := $5;
end;
Procedure SetJb(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $8;
HasOperand := true;
OperandCode := $2;
end;
Procedure SetJbe(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $8;
HasOperand := true;
OperandCode := $3;
end;
Procedure SetJe(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $8;
HasOperand := true;
OperandCode := $0;
end;
Procedure SetJne(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $8;
HasOperand := true;
OperandCode := $1;
end;
Procedure SetNot(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $10;
end;
Procedure SetOr(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $20;
end;
Procedure SetAnd(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $40;
end;
Procedure SetCmp(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $60;
end;
Procedure SetSub(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $80;
end;
Procedure SetAdd(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $A0;
end;
Procedure SetMovReg(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $C0;
end;
Procedure SetMovMem(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $E0;
end;
Procedure SetBRK(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $0;
HasOperand := true;
OperandCode := $3;
end;
Procedure SetIret(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $0;
HasOperand := true;
OperandCode := $4;
end;
Procedure SetHalt(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $0;
HasOperand := true;
OperandCode := $5;
end;
Procedure SetPut(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $0;
HasOperand := true;
OperandCode := $7;
end;
Procedure SetGet(Pat:TPatPtr);
begin
HasOpcode := True;
Opcode := $0;
HasReg := true;
RegCode := $0;
HasOperand := true;
OperandCode := $6;
end;
Procedure SetAX(Pat:TPatPtr);
begin
HasReg := True;
Regcode := $00;
end;
Procedure SetBX(Pat:TPatPtr);
begin
HasReg := True;
Regcode := $08;
end;
Procedure SetCX(Pat:TPatPtr);
begin
HasReg := True;
Regcode := $10;
end;
Procedure SetDX(Pat:TPatPtr);
begin
HasReg := True;
Regcode := $18;
end;
Procedure SetAX2(Pat:TPatPtr);
begin
HasOperand := True;
Operandcode := $00;
end;
Procedure SetBX2(Pat:TPatPtr);
begin
HasOperand := True;
Operandcode := $1;
end;
Procedure SetCX2(Pat:TPatPtr);
begin
HasOperand := True;
Operandcode := $2;
end;
Procedure SetDX2(Pat:TPatPtr);
begin
HasOperand := True;
Operandcode := $3;
end;
Procedure SetBXInd(Pat:TPatPtr);
begin
HasOperand := True;
Operandcode := $4;
end;
Procedure SetBXIndx(Pat:TPatPtr);
begin
HasOperand := True;
Operandcode := $5;
end;
Procedure SetABS(Pat:TPatPtr);
begin
HasOperand := True;
Operandcode := $6;
end;
Procedure SetImm(Pat:TPatPtr);
begin
HasOperand := True;
Operandcode := $7;
end;
{$F-}
{ Whenever the user presses the CLEAR button on the memory page, the }
{ following method zeros out memory. }
procedure TSIMx86Form.ClrMemBtnClick(Sender: TObject);
var i:word;
begin
AdrsEntry.Text := '0000';
AdrsEntryChange(AdrsEntry);
{ Zero out memory }
for i := 0 to $ffef do
Memory^[i] := 0;
MemAdrs := 0;
Adrs := 0;
end;
{ Handle the NEW, OPEN, SAVE, SAVEAS, Print, and QUIT entries in the File Menu }
procedure TSIMx86Form.QuitClick(Sender: TObject);
begin
Application.Terminate;
end;
procedure TSIMx86Form.PrintMenuItemClick(Sender: TObject);
var
i: integer;
f: TextFile;
begin
if PrintDialog.Execute then begin
if (SIMx86Pages.PageIndex = 0) then begin
AssignPrn(f);
Rewrite(f);
for i := 0 to SourceCode.Lines.Count-1 do
writeln(f,SourceCode.Lines[i]);
CloseFile(f);
end
else Print;
end;
end;
procedure TSIMx86Form.NewClick(Sender: TObject);
begin
SourceCode.Clear;
Filename := '';
end;
procedure TSIMx86Form.OpenClick(Sender: TObject);
var
name:string;
begin
if OpenDialog.Execute then
begin
SourceCode.Lines.LoadFromFile(OpenDialog.Filename);
Filename := OpenDialog.Filename;
end;
end;
procedure TSIMx86Form.SaveAsClick(Sender: TObject);
begin
if SaveDialog.Execute then
begin
FileName := SaveDialog.Filename;
SourceCode.Lines.SaveToFile(SaveDialog.Filename);
end;
end;
procedure TSIMx86Form.SaveClick(Sender: TObject);
begin
if (Filename = '') then
begin
if SaveDialog.Execute then
Filename := SaveDialog.Filename;
end;
if (Filename <> '') then
begin
SourceCode.Lines.SaveToFile(Filename);
end;
end;
{ Handle Cut, Copy, Paste, Delete, and SelectAll in the Edit Menu }
procedure TSIMx86Form.CutClick(Sender: TObject);
begin
SourceCode.CutToClipBoard;
end;
procedure TSIMx86Form.CopyClick(Sender: TObject);
begin
SourceCode.CopyToClipBoard;
end;
procedure TSIMx86Form.PasteClick(Sender: TObject);
begin
SourceCode.PasteFromClipBoard;
end;
procedure TSIMx86Form.DeleteClick(Sender: TObject);
begin
SourceCode.ClearSelection;
end;
procedure TSIMx86Form.SelectAllClick(Sender: TObject);
begin
SourceCode.SelectAll;
SourceCode.Repaint;
end;
{ Whenver a value changes in one of the memory data entry boxes, this }
{ method converts the data data to hexadecimal and stores the resulting }
{ value away into memory. }
procedure TSIMx86Form.HexChange(Sender: TObject);
var Cell:TEdit;
HexVal:byte;
i,
j,
index:word;
begin
Cell := TEdit(Sender);
CheckHex(Cell);
{ Only store the data if there is no error. If there is an error, }
{ the memory cell's background color will be red. }
if (Cell.Color <> clRed) then
begin
for i := 0 to 7 do
for j := 0 to 7 do
if (Sender = MemEntry[i,j]) then
WriteMem(MemAdrs+ i*8+j, HexToWord(Cell.Text));
end;
end;
{ AdrsEntryChange- This method executes whenever the user changes }
{ a value in the address box on the Memory page. }
{ This method converts the string representation }
{ of the address to binary, updates all the labels}
{ on the screen, and then updates all the memory }
{ entry boxes on the page. }
procedure TSIMx86Form.AdrsEntryChange(Sender: TObject);
var
HexVal: word;
index: word;
i,j: word;
begin
CheckHex(TEdit(Sender));
{ If the entry is invalid, don't do anything. }
if (AdrsEntry.Color <> clRed) then begin
HexVal := HexToWord(AdrsEntry.Text);
{ Update the labels on the page. Make sure the values we use }
{ are all even multiples of eight. }
MemAdrs := HexVal and $FFF8;
Lbl8.Caption := IntToHex(MemAdrs+8,4);
Lbl10.Caption := IntToHex(MemAdrs+16,4);
Lbl18.Caption := IntToHex(MemAdrs+24,4);
Lbl20.Caption := IntToHex(MemAdrs+32,4);
Lbl28.Caption := IntToHex(MemAdrs+40,4);
Lbl30.Caption := IntToHex(MemAdrs+48,4);
Lbl38.Caption := IntToHex(MemAdrs+56,4);
{ Update the data in the entry cells on the page. If }
{ the location we access is before the starting address }
{ (because we may have rounded it down to the previous }
{ eight-byte boundary), then turn the background color }
{ gray. }
for i := 0 to 7 do
for j := 0 to 7 do
begin
index := MemAdrs + i*8 + j;
MemEntry[i,j].Text := IntToHex(ReadMem(index),2);
if ((index < HexVal) or (Index >=$fff0)) then
begin
MemEntry[i,j].Color := clSilver;
MemEntry[i,j].Enabled := false;
end
else begin
MemEntry[i,j].Color := clWindow;
MemEntry[i,j].Enabled := true;
end;
end;
end;
end;
procedure TSIMx86Form.StartAdrsChange(Sender: TObject);
begin
CheckHex(StartAdrs);
end;
{ Do the assembly here }
procedure TSIMx86Form.ASMbtnClick(Sender: TObject);
var
i:word;
ch:char;
line:array[0..255] of char;
s:PChar;
begin
{ Initialize the symbol table }
for ch := 'A' to 'Z' do
begin
SymTbl[ch].Value := 0;
SymTbl[ch].Defined := false;
end;
{ Compute the address of the first instruction }
if (StartAdrs.Color <> clRed) then
Adrs := HexToWord(StartAdrs.Text)
else Adrs := 0;
{ Assemble each line of source code }
for LineNum := 0 to SourceCode.Lines.Count-1 do begin
s := strPCopy(line, SourceCode.Lines[LineNum]);
NoError := true;
HasValue := false;
HasOpcode := false;
HasReg := false;
HasOperand := false;
if (not Match(stmt, s)) then
begin
if (NoError) then
ErrorMsg('Syntax Error',
SourceCode.lines[LineNum]);
if (AbortAsm) then break;
end
else begin
{ Okay, the instruction is syntactically cor- }
{ rect. Now emit the opcode and any necessary }
{ operands to memory. }
Val := 0;
if (HasOpcode) then {It's not a blank line }
begin
Val := Val or Opcode;
if (HasReg) then Val := Val or Regcode;
if (HasOperand) then Val := Val or OperandCode;
WriteMem(Adrs, Val);
inc(adrs);
if (HasValue) then begin {It has an operand }
WriteMem(Adrs, OperandValue and $ff);
inc(adrs);
WriteMem(Adrs, OperandValue shr 8);
inc (adrs);
end;
end;
end;
end;
{ Check to see if there were any undefined symbols }
for ch := 'A' to 'Z' do
if (not SymTbl[ch].Defined)then
if (SymTbl[ch].Value <> 0) then
ErrorMsg('Undefined Symbol', ch);
end;
{ Given an opcode, the following function returns the size of }
{ an instruction (in bytes). This is either one or three. }
function InstrSz(opcode:word):integer;
begin
if (opcode > $1f) or ((opcode and $18) = $10) then
if (opcode and $7) >= 5 then Result := 3
else Result := 1
else if (opcode and $18) = $8 then Result := 3
else Result := 1;
end;
{ Given an opcode, the following function returns a string that }
{ corresponds to the instruction's mnemonic. }
function Instr(opcode:word):string;
begin
Result := '????';
case (opcode shr 5) of
1: Result := 'or ';
2: Result := 'and ';
3: Result := 'cmp ';
4: Result := 'sub ';
5: Result := 'add ';
6: Result := 'mov ';
7: Result := 'mov ';
0: begin
if (opcode and $18) = $10 then
Result := 'not '
else if (opcode and $18) = $8 then
begin
case opcode and $7 of
0: Result := 'je ';
1: Result := 'jne ';
2: Result := 'jb ';
3: Result := 'jbe ';
4: Result := 'ja ';
5: Result := 'jae ';
6: Result := 'jmp ';
7: Result := '****';
end;
end
else if (opcode and $18) = $18 then Result := '****'
else begin
case (opcode and $7) of
0: Result := '****';
1: Result := '****';
2: Result := '****';
3: Result := 'brk ';
4: Result := 'iret';
5: Result := 'halt';
6: Result := 'get ';
7: Result := 'put ';
end;
end;
end;
end;
end;
{ Given an opcode and an option operand, the following function returns }
{ a string that represents the reg/memory addressing mode. }
function AdrsMode(opcode, operand:word):string;
function MemMode(opcode,operand:word):string;
begin
case opcode and $7 of
0: Result := 'ax';
1: Result := 'bx';
2: Result := 'cx';
3: Result := 'dx';
4: Result := '[bx]';
5: Result := '['+IntToHex(operand,4)+'+bx]';
6: Result := '['+IntToHex(operand,4)+']';
7: Result := IntToHex(operand,4);
end;
end;
begin
if (opcode > $1f) or (opcode and $18 = $10) then
Result := MemMode(opcode,operand)
else if (opcode and $18 = $8) then
Result := MemMode($27, operand)
else Result := '';
end;
{ The following function disassembles a single instruction at the given }
{ address and returns the string representation of that instruction. }
function Disassemble2(var CodeAdrs:word):string;
var Size,
Operand:word;
begin
Result := IntToHex(CodeAdrs,4) + ': ' +
IntToHex(ReadMem(CodeAdrs),2) + ' ';
Size := InstrSz(ReadMem(CodeAdrs));
Opcode := ReadMem(CodeAdrs);
if Size = 1 then
begin
Result := Result + ' ';
inc(CodeAdrs);
end
else begin
Result := Result +
IntToHex(ReadMem(CodeAdrs+1),2) + ' ' +
IntToHex(ReadMem(CodeAdrs+2),2) + ' ';
Operand := ReadMem(CodeAdrs+1) + (ReadMem(CodeAdrs+2) shl 8);
CodeAdrs := CodeAdrs + 3;
end;
Result := Result + Instr(opcode) + ' ';
case (opcode shr 5) of
1,2,3,4,5,6:begin
case ((opcode shr 3) and $3) of
0: Result := Result + 'ax, ';
1: Result := Result + 'bx, ';
2: Result := Result + 'cx, ';
3: Result := Result + 'dx, ';
end;
Result := Result + AdrsMode(Opcode, Operand);
end;
7:begin
Result := Result + AdrsMode(Opcode, Operand) + ', ';
case ((opcode shr 3) and $3) of
0: Result := Result + 'ax';
1: Result := Result + 'bx';
2: Result := Result + 'cx';
3: Result := Result + 'dx';
end;
end;
0: begin
case (opcode shr 3) and $3 of
1: Result := Result + IntToHex(Operand,4);
2: Result := Result + AdrsMode(Opcode,Operand);
end;
end;
end;
end;
function Disassemble(CodeAdrs:word):string;
begin
Result := Disassemble2(CodeAdrs);
end;
{ The following event method handles switching between pages on the form. }
procedure TSIMx86Form.Simx86PagesChange(Sender: TObject;
NewTab: Integer;
var AllowChange: Boolean);
var DisAdrs:word;
i:integer;
begin
{ Don't allow a change if a program is running. }
if (Running and (NewTab = 0)) then
begin
AllowChange := false;
end
{ If the user switches to the memory page, redraw all the cells. }
else if (NewTab = 1) then
AdrsEntryChange(AdrsEntry)
{ If the user switches to the execute page, disassemble some }
{ code for the disassembly list box. }
else if (NewTab = 2) then
begin
DisAdrs := HexToWord(DisAsmAdrs.Text);
DisAsm.Clear;
for i := 1 to 15 do
DisAsm.Items.Add(Disassemble2(DisAdrs));
Instruction.Caption := Disassemble(IP);
end;
end;
{ If the user changes the address in the TEdit box at the bottom of the }
{ disassembly list box, the following procedure converts this to a word }
{ and disassembles 15 instructions starting at this new address. }
procedure TSIMx86Form.DisAsmAdrsChange(Sender: TObject);
var i:integer;
DisAdrs:word;
begin
DisAdrs := HexToWord(DisAsmAdrs.Text);
DisAsm.Clear;
for i := 1 to 15 do
DisAsm.Items.Add(Disassemble2(DisAdrs));
end;
{ If the user presses on the down portion of the spinner at the bottom }
{ of the disassembly list box, this method increments the disassembly }
{ address and updates the disassembly list box. }
procedure TSIMx86Form.SpinButtonDownClick(Sender: TObject);
var value:word;
begin
Value := HexToWord(DisAsmAdrs.Text);
inc(Value);
DisAsmAdrs.Text := IntToHex(Value,4);
end;
{ If they press on the up arrow portion of the spinner, this code will }
{ decrement the starting disassembly address and update the list box. }
procedure TSIMx86Form.SpinButtonUpClick(Sender: TObject);
var value:word;
begin
Value := HexToWord(DisAsmAdrs.Text);
dec(Value);
DisAsmAdrs.Text := IntToHex(Value,4);
end;
procedure OneInstr;
procedure Store(mode:byte; index:word; value: word);
begin
case mode of
0: AX := value;
1: BX := value;
2: CX := value;
3: DX := value;
4: begin
WriteMem(bx, value and $FF);
WriteMem(bx+1, value shr 8);
end;
5: begin
WriteMem(bx+index, value and $FF);
WriteMem(bx+index+1, value shr 8);
end;
6: begin
WriteMem(index, value and $FF);
WriteMem(index+1, value shr 8);
end;
end;
end;
begin
with SIMx86Form do begin
if (PendingInt) and (not InInt) then
if (IntAdrs <> $FFFF) then
begin
InInt := true;
SaveAX := AX;
SaveBX := BX;
SaveCX := CX;
SaveDX := DX;
SaveIP := IP;
SaveLess := LessThanFlag.Checked;
SaveEqual:= EqualFlag.Checked;
PendingInt := false;
IP := IntAdrs;
end;
{ Okay, do the instruction here. }
Opcode := ReadMem(IP);
Operation := Opcode shr 5;
Reg := (Opcode shr 3) and $3;
RegMem := Opcode and $7;
InstrSize := 1;
case Reg of
0: Op1 := @AX;
1: Op1 := @BX;
2: Op1 := @CX;
3: Op1 := @DX;
end;
case RegMem of
0: Op2v := AX;
1: Op2v := BX;
2: Op2v := CX;
3: Op2v := DX;
4: Op2v := ReadMem(BX) + (ReadMem(BX+1) shl 8);
5: begin {[1000+bx]}
offset := BX + ReadMem(IP+1) + ReadMem(IP+2) shl 8;
Op2v := ReadMem(offset) + ReadMem(offset+1) shl 8;
InstrSize := 3;
end;
6: begin {[1000]}
offset := ReadMem(IP+1) + ReadMem(IP+2) shl 8;
Op2v := ReadMem(offset) + ReadMem(offset+1) shl 8;
InstrSize := 3;
end;
7: begin {1000}
Op2v := ReadMem(IP+1) + ReadMem(IP+2) shl 8;
InstrSize := 3;
end;
end;
case Operation of
1: Op1^ := Op1^ or Op2v;
2: Op1^ := Op1^ and Op2v;
3: begin
LessThanFlag.Checked := Op1^ < Op2v;
EqualFlag.Checked := Op1^ = Op2v;
end;
4: Op1^ := Op1^ - Op2v;
5: Op1^ := Op1^ + Op2v;
6: Op1^ := Op2v;
7: Store(regmem, ReadMem(IP+1) + ReadMem(IP+2) shl 8, Op1^);
0: case Reg of
2: Store(regmem,
ReadMem(IP+1) + ReadMem(IP+2) shl 8,
not Op2v);
1: begin {jumps}
InstrSize := 0;
case RegMem of
0: if EqualFlag.Checked then
IP := ReadMem(IP+1) +
ReadMem(IP+2) shl 8
else InstrSize := 3;
1: if not EqualFlag.Checked then
IP := ReadMem(IP+1) +
ReadMem(IP+2) shl 8
else InstrSize := 3;
2: if LessThanFlag.Checked then
IP := ReadMem(IP+1) +
ReadMem(IP+2) shl 8
else InstrSize := 3;
3: if LessThanFlag.Checked or
EqualFlag.Checked then
IP := ReadMem(IP+1) +
ReadMem(IP+2) shl 8
else InstrSize := 3;
4: if not (LessThanFlag.Checked or
EqualFlag.Checked) then
IP := ReadMem(IP+1) +
ReadMem(IP+2) shl 8
else InstrSize := 3;
5: if not LessThanFlag.Checked then
IP := ReadMem(IP+1) +
ReadMem(IP+2) shl 8
else InstrSize := 3;
6: IP := ReadMem(IP+1) + ReadMem(IP+2) shl 8;
7: begin
ErrorMsg('Illegal instruction',
IntToHex(IP,4));
Halted := true;
end;
end;
end;
3: begin
ErrorMsg('Illegal instruction',IntToHex(IP,4));
Halted := true;
end;
0: case (RegMem) of
0,1,2:begin
ErrorMsg('Illegal instruction',IntToHex(IP,4));
Halted := true;
InstrSize := 0;
end;
3: begin
ErrorMsg('BRK encountered',IntToHex(IP,4));
Halted := true;
InstrSize := 1;
end;
4: if (not InInt) then
begin
ErrorMsg('IRET encountered outside interrupt',
IntToHex(IP,4));
Halted := true;
InstrSize := 0;
end
else begin
AX := SaveAX;
BX := SaveBX;
CX := SaveCX;
DX := SaveDX;
IP := SaveIP;
LessThanFlag.Checked := SaveLess;
EqualFlag.Checked := SaveEqual;
InstrSize := 0;
InInt := false;
end;
5: begin
ErrorMsg('Halt encountered',IntToHex(IP,4));
Halted := true;
InstrSize := 0;
end;
6: begin
InputForm.ShowModal;
AX := InputValue;
InstrSize := 1;
end;
7: begin
Output.Items.Add(IntToHex(AX,4));
InstrSize := 1;
end;
end;
end;
end;
IP := IP + InstrSize;
end;
end;
procedure StopPgm;
begin
with SIMx86Form do begin
IPValue.Enabled := true;
DisAsmAdrs.Enabled := true;
SpinButton.Enabled := true;
RunBtn.Enabled := true;
StepBtn.Enabled := true;
AXValue.Enabled := true;
BXValue.Enabled := true;
CXValue.Enabled := true;
DXValue.Enabled := true;
LessThanFlag.Enabled := true;
EqualFlag.Enabled := true;
HaltBtn.Enabled := false;
RunningLite.Color := clGray;
MainMenu.Items[0].Enabled := true;
MainMenu.Items[1].Enabled := true;
PendingInt := false;
Instruction.Caption := Disassemble(IP);
end;
end;
{ If the users presses the "RUN" button, the following code kicks in }
{ the emulator. }
procedure TSIMx86Form.RunBtnClick(Sender: TObject);
begin
IPValue.Enabled := false;
DisAsmAdrs.Enabled := false;
SpinButton.Enabled := false;
RunBtn.Enabled := false;
StepBtn.Enabled := false;
AXValue.Enabled := false;
BXValue.Enabled := false;
CXValue.Enabled := false;
DXValue.Enabled := false;
LessThanFlag.Enabled := false;
EqualFlag.Enabled := false;
HaltBtn.Enabled := true;
RunningLite.Color := clRed;
PendingInt := false;
MainMenu.Items[0].Enabled := false;
MainMenu.Items[1].Enabled := false;
Halted := false;
Running := true;
InInt := false;
while not Halted do begin
Application.ProcessMessages;
OneInstr;
end;
Running := false;
RunningLite.Color := clGray;
StopPgm;
IPValue.Text := IntToHex(IP,4);
AXValue.Text := IntToHex(AX,4);
BXValue.Text := IntToHex(BX,4);
CXValue.Text := IntToHex(CX,4);
DXValue.Text := IntToHex(DX,4);
end;
procedure TSIMx86Form.HaltBtnClick(Sender: TObject);
begin
StopPgm;
Halted := true;
end;
{ If the user presses the reset button, the following method resets }
{ the machine. }
procedure TSIMx86Form.ResetBtnClick(Sender: TObject);
begin
AX := 0;
BX := 0;
CX := 0;
DX := 0;
AXValue.Text := '0000';
BXValue.Text := '0000';
CXValue.Text := '0000';
DXValue.Text := '0000';
if (ResetVect.Color <> clRed) then
begin
IP := HexToWord(ResetVect.Text);
IPValue.Text := ResetVect.Text;
end
else begin
IP := 0;
IPValue.Text := '0000';
end;
LessThanFlag.Checked := false;
EqualFlag.Checked := false;
PendingInt := false;
StopPgm;
Halted := true;
Output.Items.Clear;
Input.Items.Clear;
Instruction.Caption := Disassemble(IP);
end;
procedure TSIMx86Form.InterruptBtnClick(Sender: TObject);
begin
PendingInt := true;
end;
procedure TSIMx86Form.IntVectChange(Sender: TObject);
begin
CheckHex(IntVect);
if (IntVect.Color <> clRed) then
begin
IntAdrs := HexToWord(IntVect.Text);
end;
end;
procedure TSIMx86Form.IPValueChange(Sender: TObject);
begin
CheckHex(IPValue);
if IPValue.Color <> clRed then
begin
IP := HexToWord(IPValue.Text);
end;
Instruction.Caption := Disassemble(IP);
end;
procedure TSIMx86Form.StepBtnClick(Sender: TObject);
begin
OneInstr;
IPValue.Text := IntToHex(IP,4);
AXValue.Text := IntToHex(AX,4);
BXValue.Text := IntToHex(BX,4);
CXValue.Text := IntToHex(CX,4);
DXValue.Text := IntToHex(DX,4);
Instruction.Caption := Disassemble(IP);
end;
end.
