Add an assembler, a section on the assembly language on the readme, example assembly files, and proper error handling to the emulator and disassembler

This commit is contained in:
CrazyEttin 2022-07-31 14:09:15 +03:00
parent bbb2a1a695
commit c4c41274f9
6 changed files with 592 additions and 28 deletions

6
.gitignore vendored
View File

@ -1,6 +1,8 @@
/*
!/disassembler.pas
!/emulator.pas
!/*.pas
!/examples/
/examples/*
!/examples/*.asm
!/.gitignore
!/license.md
!/readme.md

355
assembler.pas Normal file
View File

@ -0,0 +1,355 @@
program Assembler;
{$MODE OBJFPC}
uses Sysutils, Strutils;
type
//Label or reference table entry
LblRec = record
Addr: word;
Lbl: string;
end;
var
LP, Count: integer; //Line pointer and generic counter
Line, DatOrg: string; //Line of assembly and data or org element
Elem: array [0 .. 4] of string; //Parsed elements
Lbl, Ref: array [0 .. $ffff] of LblRec; //Label and reference tables
Addr, BP, SP, EP: word; //Address argument and byte, start, and end pointers
Bin: array [0 .. $ffef] of byte; //Assembled binary
Prog: file of byte; //Program file
//Print an argument error and abort
procedure ArgError;
begin
writeln ('Error (line ', LP, '): incorrect argument(s)');
halt;
end;
//Print a memory error and abort if the assembler is about to write beyond available memory
procedure MemError;
begin
if (BP + 2) >= $fff0 then begin
writeln ('Error (line ', LP, '): out of memory');
halt;
end;
end;
//Assemble a first or only argument that is a register
procedure FirstArgReg;
begin
if CompareText (Elem [2], 'R0') = 0 then Bin [BP] := Bin [BP] + 0
else if CompareText (Elem [2], 'R1') = 0 then Bin [BP] := Bin [BP] + 4
else if CompareText (Elem [2], 'R2') = 0 then Bin [BP] := Bin [BP] + 8
else if CompareText (Elem [2], 'R3') = 0 then Bin [BP] := Bin [BP] + $c
else ArgError;
end;
//Assemble two register arguments
procedure TwoArgRegs;
begin
//First argument
FirstArgReg;
//Second argument
if CompareText (Elem [3], 'R0') = 0 then Bin [BP] := Bin [BP] + 0
else if CompareText (Elem [3], 'R1') = 0 then Bin [BP] := Bin [BP] + 1
else if CompareText (Elem [3], 'R2') = 0 then Bin [BP] := Bin [BP] + 2
else if CompareText (Elem [3], 'R3') = 0 then Bin [BP] := Bin [BP] + 3
else ArgError;
end;
begin
//Check for an set up a program file
if ParamCount <> 1 then begin
writeln ('Usage: assembler program (< input)');
halt;
end;
//Initialise the byte and start pointers
LP := 1;
BP := 0;
SP := 0;
//Begin the main loop
repeat
//Read a line
readln (Line);
//Remove the comment if any
Line := Trim (ExtractDelimited (1, Line, [';']));
//Check for an empty line
if Line <> '' then begin
//(Re-)initialise the elements
Elem [0] := '';
Elem [1] := '';
Elem [2] := '';
Elem [3] := '';
Elem [4] := '';
//Check if the first element is a label
if RightStr (Trim (ExtractWord (1, Line, [' ', ' '])), 1) = ':' then begin
//Find the first empty slot in the label table
Count := 0;
while Lbl [Count] .Lbl <> '' do Count := Count + 1;
//Extract the label
Lbl [Count] .Addr := BP;
Elem [0] := Trim (ExtractDelimited (1, Line, [':']));
Lbl [Count] .Lbl := Elem [0];
Line := Trim (ExtractDelimited (2, Line, [':']));
//Check for forward references
Count := 0;
repeat
while CompareText (Elem [0], Ref [Count] .Lbl) <> 0 do begin
if Ref [Count] .Lbl = '' then break;
Count := Count + 1;
end;
if Ref [Count] .Lbl <> '' then begin
Bin [Ref [Count] .Addr] := BP shr 8;
Bin [Ref [Count] .Addr + 1] := BP and $00ff;
Count := Count + 1;
end;
until Ref [Count] .Lbl = '';
end;
//Check for the org pseudo-instruction
if CompareText (Trim (ExtractWord (1, Line, [' ', ' '])), 'ORG') = 0 then begin
if BP = 0 then begin
if Elem [0] = '' then begin
//Set the starting point
if Trim (ExtractWord (3, Line, [' ', ' '])) <> '' then ArgError;
DatOrg := Trim (ExtractWord (2, Line, [' ', ' ']));
try
if Hex2Dec (DatOrg) <=$ffff then begin
BP := Hex2Dec (DatOrg);
SP := BP;
end
else ArgError;
except
ArgError;
end;
end
else begin
writeln ('Error (line ', LP, '): ORG cannot have a label');
halt;
end;
end
else begin
writeln ('Error (line ', LP, '): ORG must be the first instruction');
halt;
end;
end
//Check for the data pseudo-instruction
else if CompareText (Trim (ExtractWord (1, Line, [' ', ' '])), 'DATA') = 0 then begin
//Extract and store the data
if Trim (ExtractWord (3, Line, [' ', ' '])) <> '' then ArgError;
DatOrg := Trim (ExtractWord (2, Line, [' ', ' ']));
try
if Hex2Dec (DatOrg) <=$ff then Bin [BP] := Hex2Dec (DatOrg)
else ArgError;
except
ArgError;
end;
//Increment the byte pointer
BP := BP + 1;
end
//Check for an instruction
else if Line <> '' then begin
//Parse the instruction
//Extract the opcode
Elem [1] := Trim (ExtractWord (1, Line, [' ', ' ']));
//Extract the arguments
Elem [2] := Trim (ExtractWord (2, Trim (ExtractDelimited (1, Line, [','])), [' ', ' ']));
Elem [3] := Trim (ExtractDelimited (2, Line, [',']));
Elem [4] := Trim (ExtractDelimited (3, Line, [',']));
//Assemble the opcode
if CompareText (Elem [1], 'HALT') = 0 then Bin [BP] := 0
else if CompareText (Elem [1], 'RET') = 0 then Bin [BP] := $10
else if CompareText (Elem [1], 'SHL') = 0 then Bin [BP] := $20
else if CompareText (Elem [1], 'SHR') = 0 then Bin [BP] := $30
else if CompareText (Elem [1], 'ROL') = 0 then Bin [BP] := $40
else if CompareText (Elem [1], 'ROR') = 0 then Bin [BP] := $50
else if CompareText (Elem [1], 'NAND') = 0 then Bin [BP] := $60
else if CompareText (Elem [1], 'AND') = 0 then Bin [BP] := $70
else if CompareText (Elem [1], 'OR') = 0 then Bin [BP] := $80
else if CompareText (Elem [1], 'XOR') = 0 then Bin [BP] := $90
else if CompareText (Elem [1], 'LOAD') = 0 then Bin [BP] := $a0
else if CompareText (Elem [1], 'STORE') = 0 then Bin [BP] := $b0
else if CompareText (Elem [1], 'BREQ') = 0 then Bin [BP] := $c0
else if CompareText (Elem [1], 'BRNEQ') = 0 then Bin [BP] := $d0
else if CompareText (Elem [1], 'CLEQ') = 0 then Bin [BP] := $e0
else if CompareText (Elem [1], 'CLNEQ') = 0 then Bin [BP] := $f0
else begin
writeln ('Error (line ', LP, '): no such instruction');
halt;
end;
//Check for incorrect number of arguments
if Bin [BP] <= $10 then begin
if Elem [2] <> '' then ArgError
else if Elem [3] <> '' then ArgError
else if Elem [4] <> '' then ArgError;
end
else if Bin [BP] <= $50 then begin
if Elem [3] <> '' then ArgError
else if Elem [4] <> '' then ArgError;
end
else if Bin [BP] <= $b0 then begin
if Elem [4] <> '' then ArgError;
end;
//Assemble the arguments
//Shifts
if Bin [BP] >= $20 then if Bin [BP] <= $50 then FirstArgReg;
//Logical operations
if Bin [BP] >= $60 then if Bin [BP] <= $90 then TwoArgRegs;
//Load
if Bin [BP] = $a0 then begin
//First argument
FirstArgReg;
//Second argument
try
//Address
if Hex2Dec (Elem [3]) <= $ffff then Addr := Hex2Dec (Elem [3])
else ArgError;
except
//Label reference
//Backwards
Count := 0;
while CompareText (Elem [3], Lbl [Count] .Lbl) <> 0 do begin
if Lbl [Count] .Lbl = '' then break;
Count := Count + 1;
end;
if Lbl [Count] .Lbl <> '' then Addr := Lbl [Count] .Addr
//Forwards
else begin
//Find the first empty slot in the reference table
Count := 0;
while Ref [Count] .Lbl <> '' do Count := Count + 1;
//Extract the reference
Ref [Count] .Addr := BP + 1;
Ref [Count] .Lbl := Elem [3];
//Placeholder
Addr := 0;
end;
end;
MemError;
Bin [BP + 1] := Addr shr 8;
Bin [BP + 2] := Addr and $00ff;
end;
//Store
if Bin [BP] = $b0 then begin
//First argument
try
//Address
if Hex2Dec (Elem [2]) <= $ffff then Addr := Hex2Dec (Elem [2])
else ArgError;
except
//Label reference
//Backwards
Count := 0;
while CompareText (Elem [2], Lbl [Count] .Lbl) <> 0 do begin
if Lbl [Count] .Lbl = '' then break;
Count := Count + 1;
end;
if Lbl [Count] .Lbl <> '' then Addr := Lbl [Count] .Addr
//Forwards
else begin
//Find the first empty slot in the reference table
Count := 0;
while Ref [Count] .Lbl <> '' do Count := Count + 1;
//Extract the reference
Ref [Count] .Addr := BP + 1;
Ref [Count] .Lbl := Elem [2];
//Placeholder
Addr := 0;
end;
end;
MemError;
Bin [BP + 1] := Addr shr 8;
Bin [BP + 2] := Addr and $00ff;
//Second argument
if CompareText (Elem [3], 'R0') = 0 then Bin [BP] := Bin [BP] + 0
else if CompareText (Elem [3], 'R1') = 0 then Bin [BP] := Bin [BP] + 4
else if CompareText (Elem [3], 'R2') = 0 then Bin [BP] := Bin [BP] + 8
else if CompareText (Elem [3], 'R3') = 0 then Bin [BP] := Bin [BP] + $c
else ArgError;
end;
//Branches and calls
if Bin [BP] >= $c0 then begin
//First and second arguments
TwoArgRegs;
//Third argument
try
//Address
if Hex2Dec (Elem [4]) <= $ffff then Addr := Hex2Dec (Elem [4])
else ArgError;
except
//Label reference
//Backwards
Count := 0;
while CompareText (Elem [4], Lbl [Count] .Lbl) <> 0 do begin
if Lbl [Count] .Lbl = '' then break;
Count := Count + 1;
end;
if Lbl [Count] .Lbl <> '' then Addr := Lbl [Count] .Addr
//Forwards
else begin
//Find the first empty slot in the reference table
Count := 0;
while Ref [Count] .Lbl <> '' do Count := Count + 1;
//Extract the reference
Ref [Count] .Addr := BP + 1;
Ref [Count] .Lbl := Elem [4];
//Placeholder
Addr := 0;
end;
end;
MemError;
Bin [BP + 1] := Addr shr 8;
Bin [BP + 2] := Addr and $00ff;
end;
//Increment the byte pointer
if Bin [BP] >= $a0 then BP := BP + 3
else BP := BP + 1;
end;
end;
//Increment the line pointer
LP := LP + 1;
//A hack for fixing an unexplained extra readln after the loop that does nothing
if BP = $fff0 then break;
until eof ();
//Set the end pointer and reset the byte pointer to the start of the program
EP := BP;
BP := SP;
//Write the program file
{$i-}
assign (Prog, ParamStr (1));
rewrite (Prog);
{$i+}
if IOResult <> 0 then begin
writeln ('Error: program file cannot be written to');
halt;
end;
repeat
write (Prog, Bin [BP]);
BP := BP + 1;
until BP = EP;
end.

View File

@ -35,23 +35,23 @@ begin
//Read a program file and check for errors
if ParamCount <> 1 then begin
writeln ('Usage: disassembler program');
exit;
writeln ('Usage: disassembler program (> output)');
halt;
end;
{$i-}
assign (Prog, ParamStr (1));
reset (Prog);
{$i+}
if IOResult <> 0 then begin
writeln ('Usage: disassembler program');
exit;
writeln ('Error: program file cannot be read from');
halt;
end;
repeat
read (Prog, Bin [BP]);
BP := BP + 1;
until (eof (Prog)) or (BP = $fff0);
//Save the end point and reinitialise the instruction pointer
//Save the end point and reinitialise the byte pointer
EP := BP;
BP := 0;
@ -64,7 +64,7 @@ begin
if BP < $10 then write (' ');
write (IntToHex (BP, 1), ' ');
//Fetch the instruction and increment the instruction pointer
//Fetch the instruction and increment the byte pointer
//Opcode
Op := Bin [BP] and $f0 shr 4;
//Register arguments
@ -97,6 +97,6 @@ begin
writeln ();
end;
until (BP >= EP);
until BP >= EP;
end.

View File

@ -6,7 +6,7 @@ const
IO = $ffff;
var
Halt: boolean; //Halt flag
Hlt: boolean; //Halt flag
Op: 0 .. $f; //Opcode
X, Y: 0 .. 3; //Register arguments
Addr, IP, RP: word; //Address argument and instruction and return pointers
@ -18,22 +18,22 @@ var
begin
//Initialise the halt flag and the pointers
Halt := false;
Hlt := false;
IP := 0;
RP := $fff0;
//Read a program file and check for errors
if ParamCount <> 1 then begin
writeln ('Usage: emulator program');
exit;
halt;
end;
{$i-}
assign (Prog, ParamStr (1));
reset (Prog);
{$i+}
if IOResult <> 0 then begin
writeln ('Usage: emulator program');
exit;
writeln ('Error: program file cannot be read from');
halt;
end;
repeat
read (Prog, Mem [IP]);
@ -44,7 +44,7 @@ begin
IP := 0;
//Begin the main loop
while (Halt = false) do begin
while Hlt = false do begin
//Fetch the instruction and increment the instruction pointer
//Opcode
@ -53,34 +53,49 @@ begin
X := Mem [IP] and $c shr 2;
Y := Mem [IP] and 3;
IP := IP + 1;
if IP > $ffef then break;
if IP > $ffef then begin
writeln ('Error: illegal instruction pointer value');
halt;
end;
//Address argument
if Op >= $a then begin
//High byte
Addr := Mem [IP];
Addr := Addr shl 8;
IP := IP + 1;
if IP > $ffef then break;
if IP > $ffef then begin
writeln ('Error: illegal instruction pointer value');
halt;
end;
//Low byte
Addr := Addr + Mem [IP];
IP := IP + 1;
if IP > $ffef then break;
if IP > $ffef then begin
writeln ('Error: illegal instruction pointer value');
halt;
end;
end;
//Decode and execute the instruction
//Halt
if Op = 0 then Halt := true
if Op = 0 then Hlt := true
//Ret
else if Op = 1 then begin
//High byte of the return address
IP := Mem [RP];
IP := IP shl 8;
RP := RP + 1;
if RP > $fff0 then break;
if RP > $fff0 then begin
writeln ('Error: illegal return pointer value');
halt;
end;
//Low byte of the return address
IP := IP + Mem [RP];
RP := RP + 1;
if RP > $fff0 then break;
if RP > $fff0 then begin
writeln ('Error: illegal return pointer value');
halt;
end;
end
//Shl
else if Op = 2 then R [X] := R [X] shl 1
@ -132,15 +147,24 @@ begin
if R [X] = R [Y] then begin
//Low byte of the return address
RP := RP - 1;
if RP > $fff0 then break;
if RP > $fff0 then begin
writeln ('Error: illegal return pointer value');
halt;
end;
Mem [RP] := IP and $ff;
//High byte of the return address
RP := RP - 1;
if RP > $fff0 then break;
if RP > $fff0 then begin
writeln ('Error: illegal return pointer value');
halt;
end;
Mem [RP] := IP shr 8;
//Call
IP := Addr;
if IP > $ffef then break;
if IP > $ffef then begin
writeln ('Error: illegal instruction pointer value');
halt;
end;
end;
end
//Clneq
@ -148,19 +172,27 @@ begin
if R [X] <> R [Y] then begin
//Low byte of the return address
RP := RP - 1;
if RP > $fff0 then break;
if RP > $fff0 then begin
writeln ('Error: illegal return pointer value');
halt;
end;
Mem [RP] := IP and $ff;
//High byte of the return address
RP := RP - 1;
if RP > $fff0 then break;
if RP > $fff0 then begin
writeln ('Error: illegal return pointer value');
halt;
end;
Mem [RP] := IP shr 8;
//Call
IP := Addr;
if IP > $ffef then break;
if IP > $ffef then begin
writeln ('Error: illegal instruction pointer value');
halt;
end;
end;
end;
//End the main loop
end
end.

157
examples/ascii.asm Normal file
View File

@ -0,0 +1,157 @@
;ASCII code printer
;Print a prompt
load r0, prompt
store ffff, r0
;Read a character to r0 and load it to r2
load r0, ffff
cleq r0, r0, newln
xor r2, r2
xor r2, r0
;Get the hexadecimal digit of the high nibble
ror r0
ror r0
ror r0
ror r0
cleq r0, r0, n2hex
;Print the digit
store ffff, r0
;Re-load the character to r0
xor r0, r0
xor r0, r2
;Get the hexadecimal digit of the low nibble
cleq r0, r0, n2hex
;Print the digit
store ffff, r0
cleq r0, r0, newln
;Halt
halt
;Print a newline
newln: load r1, cr
store ffff, r1
load r1, lf
store ffff, r1
ret
;Get the hexadecimal digit of a nibble
;Extract the low nibble
n2hex: load r1, mask
and r0, r1
;Locate the nibble in the table
load r1, tbl00
breq r0, r1, dgt0
load r1, tbl02
breq r0, r1, dgt1
load r1, tbl04
breq r0, r1, dgt2
load r1, tbl06
breq r0, r1, dgt3
load r1, tbl08
breq r0, r1, dgt4
load r1, tbl0a
breq r0, r1, dgt5
load r1, tbl0c
breq r0, r1, dgt6
load r1, tbl0e
breq r0, r1, dgt7
load r1, tbl10
breq r0, r1, dgt8
load r1, tbl12
breq r0, r1, dgt9
load r1, tbl14
breq r0, r1, dgta
load r1, tbl16
breq r0, r1, dgtb
load r1, tbl18
breq r0, r1, dgtc
load r1, tbl1a
breq r0, r1, dgtd
load r1, tbl1c
breq r0, r1, dgte
load r1, tbl1e
breq r0, r1, dgtf
;Load the hexadecimal digit of the nibble
dgt0: load r0, tbl01
breq r0, r0, n2hend
dgt1: load r0, tbl03
breq r0, r0, n2hend
dgt2: load r0, tbl05
breq r0, r0, n2hend
dgt3: load r0, tbl07
breq r0, r0, n2hend
dgt4: load r0, tbl09
breq r0, r0, n2hend
dgt5: load r0, tbl0b
breq r0, r0, n2hend
dgt6: load r0, tbl0d
breq r0, r0, n2hend
dgt7: load r0, tbl0f
breq r0, r0, n2hend
dgt8: load r0, tbl11
breq r0, r0, n2hend
dgt9: load r0, tbl13
breq r0, r0, n2hend
dgta: load r0, tbl15
breq r0, r0, n2hend
dgtb: load r0, tbl17
breq r0, r0, n2hend
dgtc: load r0, tbl19
breq r0, r0, n2hend
dgtd: load r0, tbl1b
breq r0, r0, n2hend
dgte: load r0, tbl1d
breq r0, r0, n2hend
dgtf: load r0, tbl1f
breq r0, r0, n2hend
;Return
n2hend: ret
;Characters
prompt: data 3e
cr: data d
lf: data a
;Mask
mask: data f
;Hexadecimal table
tbl00: data 0
tbl01: data 30
tbl02: data 1
tbl03: data 31
tbl04: data 2
tbl05: data 32
tbl06: data 3
tbl07: data 33
tbl08: data 4
tbl09: data 34
tbl0a: data 5
tbl0b: data 35
tbl0c: data 6
tbl0d: data 36
tbl0e: data 7
tbl0f: data 37
tbl10: data 8
tbl11: data 38
tbl12: data 9
tbl13: data 39
tbl14: data a
tbl15: data 41
tbl16: data b
tbl17: data 42
tbl18: data c
tbl19: data 43
tbl1a: data d
tbl1b: data 44
tbl1c: data e
tbl1d: data 45
tbl1e: data f
tbl1f: data 46

View File

@ -49,6 +49,24 @@ D BRNEQ RX, RY, ADDR if (RX != RY) IP = ADDR
E CLEQ RX, RY, ADDR if (RX == RY) {RP -= 2; *RP = IP; IP = ADDR}
F CLNEQ RX, RY, ADDR if (RX != RY) {RP -= 2; *RP = IP; IP = ADDR}
Assembly Language
-----------------
Lines of assembly are of the following form:
LABEL: OPER ARG1, ARG2, ARG3 ;Comment
The language is case-insensitive and uses hexadecimal numbers. A label
can consist of any alphanumeric characters as long as it is not
interpretable as a hexadecimal number. The label, instruction, and
comment elements are all optional, as is spacing between the arguments.
For the arguments of each instruction see the previous section.
In addition to the true instructions there are two pseudo-instructions.
ORG defines the starting address of the program: it can only occur as
the first instruction and cannot have a label, and is not required if
the starting address is 0. DATA introduces a byte of data.
Memory-Mapped Devices
---------------------