356 lines
14 KiB
Plaintext
356 lines
14 KiB
Plaintext
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.
|