crazyettin
/
Thingamajig
1
0
Fork 0
Code Issues Pull Requests Projects Releases 2 Wiki Activity

Add an assembler, a section on the assembly language on the readme, 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 9516fe4608
5 changed files with 435 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitignore vendored
View File

@ -1,6 +1,8 @@
/*
!/disassembler.pas
!/emulator.pas
!/*.pas
!/examples/
/examples/*
!/examples/*.pas
!/.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.

14
disassembler.pas
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.

70
emulator.pas
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.

18
readme.md
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
---------------------