Add support for relative references, improve checking for incorrect arguments, and tidy the code of the assembler and clarify and expand the assembly language section of the readme

This commit is contained in:
CrazyEttin 2022-08-02 09:21:47 +03:00
parent e2b545afa5
commit 1a3f010dd0
2 changed files with 133 additions and 153 deletions

View File

@ -8,48 +8,64 @@ type
//Label or reference table entry
LblRec = record
Addr: word;
Lbl: string;
Lbl: ansistring;
Offset: integer;
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
LP, Count, Offset: integer; //Line pointer, generic counter, and relative offset
Line, DatOrg: ansistring; //Line of assembly and data or org element
Elem: array [0 .. 4] of ansistring; //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
//Check if a string is alphanumeric
function IsAlphaNum (Arg: string): boolean;
function IsAlphaNum (S: string): boolean;
var
I: integer;
begin
for Count := 1 to length (Arg) do if not (Arg [Count] in ['a' .. 'z', 'A' .. 'Z', '0' .. '9']) then exit (false);
for I := 1 to length (S) do
if not (S [I] in ['a' .. 'z', 'A' .. 'Z', '0' .. '9']) then exit (false);
exit (true);
end;
//Print a label error and abort
procedure LblError;
begin
writeln ('Error (line ', LP, '): illegal label');
halt;
end;
//Print a reference error and abort
procedure RefError;
begin
writeln ('Error (line ', LP, '): illegal reference(s) relative to this line');
halt;
end;
//Print an argument error and abort
procedure ArgError;
begin
writeln ('Error (line ', LP, '): incorrect argument(s)');
writeln ('Error (line ', LP, '): illegal 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, '): memory overflow');
halt;
end;
writeln ('Error (line ', LP, '): memory overflow');
halt;
end;
//Assemble a first or only argument that is a register
procedure FirstArgReg;
//Assemble a single register argument
procedure OneArgReg (I: integer);
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
if CompareText (Elem [I], 'R0') = 0 then Bin [BP] := Bin [BP] + 0
else if CompareText (Elem [I], 'R1') = 0 then Bin [BP] := Bin [BP] + 4
else if CompareText (Elem [I], 'R2') = 0 then Bin [BP] := Bin [BP] + 8
else if CompareText (Elem [I], 'R3') = 0 then Bin [BP] := Bin [BP] + $c
else ArgError;
end;
@ -57,7 +73,7 @@ end;
procedure TwoArgRegs;
begin
//First argument
FirstArgReg;
OneArgReg (2);
//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
@ -66,9 +82,68 @@ begin
else ArgError;
end;
//Assemble an address argument
procedure AddrArg (I: integer);
begin
Offset := 0;
try
//Address
if Hex2Dec (Elem [I]) <= $ffff then Addr := Hex2Dec (Elem [I])
else ArgError;
except
//Label reference
//Check if the reference is relative
if Trim (ExtractDelimited (2, Elem [I], ['+', '-'])) <> '' then begin
//Check for more than one offset
if Trim (ExtractDelimited (3, Elem [I], ['+', '-'])) <> '' then ArgError;
//Extract the offset
try
if Hex2Dec (Trim (ExtractDelimited (2, Elem [I], ['+', '-']))) <= $ffff
then Offset := Hex2Dec (Trim (ExtractDelimited (2, Elem [I], ['+', '-'])))
else ArgError;
except
ArgError;
end;
if Trim (ExtractDelimited (2, Elem [I], ['-'])) <> '' then Offset := -Offset;
Elem [I] := Trim (ExtractDelimited (1, Elem [I], ['+', '-']));
end;
//Check if the reference is alphanumeric
if IsAlphaNum (Elem [I]) = false then ArgError;
//Backwards
Count := 0;
while CompareText (Elem [I], 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;
//Store the reference in the table
Ref [Count] .Addr := BP + 1;
Ref [Count] .Lbl := Elem [I];
Ref [Count] .Offset := Offset;
//Placeholder
Addr := 0;
Offset := 0;
end;
end;
if (BP + 2) >= $fff0 then MemError;
//Add the offset
if Addr + Offset >= 0 then begin
if Addr + Offset <= $ffff then Addr := Addr + Offset
else ArgError;
end
else ArgError;
Bin [BP + 1] := Addr shr 8;
Bin [BP + 2] := Addr and $00ff;
end;
begin
//Check for an set up a program file
//Check for and set up a program file
if ParamCount <> 1 then begin
writeln ('Usage: assembler program (< input)');
halt;
@ -86,10 +161,10 @@ begin
readln (Line);
//A hack for fixing an unexplained extra readln after the loop that does nothing
if BP = $fff0 then begin
writeln ('Error (line ', LP, '): memory overflow');
halt;
end;
if BP = $fff0 then MemError;
//Convert tabs to spaces
Line := Tab2Space (Line, 1);
//Remove the comment if any
Line := Trim (ExtractDelimited (1, Line, [';']));
@ -105,21 +180,17 @@ begin
Elem [4] := '';
//Check if the first element is a label
if RightStr (Trim (ExtractWord (1, Line, [' ', ' '])), 1) = ':' then begin
if RightStr (ExtractWord (1, Line, [' ']), 1) = ':' then begin
//Extract the label
Elem [0] := Trim (ExtractDelimited (1, Line, [':']));
Line := Trim (ExtractDelimited (2, Line, [':']));
//Check if the label is hexadecimal
try
Count := Hex2Dec (Elem [0]);
writeln ('Error (line ', LP, '): labels cannot be hexadecimal numbers');
halt;
LblError;
except
//Check if the label is alphanumeric
if IsAlphaNum (Elem [0]) = false then begin
writeln ('Error (line ', LP, '): labels must be alphanumeric');
halt;
end;
if IsAlphaNum (Elem [0]) = false then LblError;
//Find the first empty slot in the label table
Count := 0;
while Lbl [Count] .Lbl <> '' do Count := Count + 1;
@ -134,8 +205,15 @@ begin
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;
//Add the offset and store the address
if BP + Ref [Count] .Offset >= 0 then begin
if BP + Ref [Count] .Offset <= $ffff then begin
Bin [Ref [Count] .Addr] := (BP + Ref [Count] .Offset) shr 8;
Bin [Ref [Count] .Addr + 1] := (BP + Ref [Count] .Offset) and $00ff;
end
else RefError;
end
else RefError;
Count := Count + 1;
end;
until Ref [Count] .Lbl = '';
@ -143,12 +221,12 @@ begin
end;
//Check for the org pseudo-instruction
if CompareText (Trim (ExtractWord (1, Line, [' ', ' '])), 'ORG') = 0 then begin
if CompareText (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, [' ', ' ']));
if ExtractWord (3, Line, [' ']) <> '' then ArgError;
DatOrg := ExtractWord (2, Line, [' ']);
try
if Hex2Dec (DatOrg) <=$ffff then begin
BP := Hex2Dec (DatOrg);
@ -159,10 +237,7 @@ begin
ArgError;
end;
end
else begin
writeln ('Error (line ', LP, '): ORG cannot have a label');
halt;
end;
else LblError;
end
else begin
writeln ('Error (line ', LP, '): ORG must be the first instruction');
@ -171,10 +246,10 @@ begin
end
//Check for the data pseudo-instruction
else if CompareText (Trim (ExtractWord (1, Line, [' ', ' '])), 'DATA') = 0 then begin
else if CompareText (ExtractWord (1, Line, [' ']), 'DATA') = 0 then begin
//Extract and store the data
if Trim (ExtractWord (3, Line, [' ', ' '])) <> '' then ArgError;
DatOrg := Trim (ExtractWord (2, Line, [' ', ' ']));
if ExtractWord (3, Line, [' ']) <> '' then ArgError;
DatOrg := ExtractWord (2, Line, [' ']);
try
if Hex2Dec (DatOrg) <=$ff then Bin [BP] := Hex2Dec (DatOrg)
else ArgError;
@ -190,9 +265,9 @@ begin
//Parse the instruction
//Extract the opcode
Elem [1] := Trim (ExtractWord (1, Line, [' ', ' ']));
Elem [1] := Copy2SpaceDel (Line);
//Extract the arguments
Elem [2] := Trim (ExtractWord (2, Trim (ExtractDelimited (1, Line, [','])), [' ', ' ']));
Elem [2] := Trim (ExtractDelimited (1, Line, [',']));
Elem [3] := Trim (ExtractDelimited (2, Line, [',']));
Elem [4] := Trim (ExtractDelimited (3, Line, [',']));
@ -219,7 +294,8 @@ begin
end;
//Check for incorrect number of arguments
if Bin [BP] <= $10 then begin
if Trim (ExtractDelimited (4, Line, [','])) <> '' then ArgError
else if Bin [BP] <= $10 then begin
if Elem [2] <> '' then ArgError
else if Elem [3] <> '' then ArgError
else if Elem [4] <> '' then ArgError;
@ -234,129 +310,29 @@ begin
//Assemble the arguments
//Shifts
if Bin [BP] >= $20 then if Bin [BP] <= $50 then FirstArgReg;
if Bin [BP] >= $20 then if Bin [BP] <= $50 then OneArgReg (2);
//Logical operations
if Bin [BP] >= $60 then if Bin [BP] <= $90 then TwoArgRegs;
//Load
if Bin [BP] = $a0 then begin
//First argument
FirstArgReg;
OneArgReg (2);
//Second argument
try
//Address
if Hex2Dec (Elem [3]) <= $ffff then Addr := Hex2Dec (Elem [3])
else ArgError;
except
//Label reference
//Check if the reference is alphanumeric
if IsAlphaNum (Elem [3]) = false then begin
writeln ('Error (line ', LP, '): references must be alphanumeric');
halt;
end;
//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;
//Store the reference in the table
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;
AddrArg (3);
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
//Check if the reference is alphanumeric
if IsAlphaNum (Elem [2]) = false then begin
writeln ('Error (line ', LP, '): references must be alphanumeric');
halt;
end;
//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;
//Store the reference in the table
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;
AddrArg (2);
//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;
OneArgReg (3);
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
//Check if the reference is alphanumeric
if IsAlphaNum (Elem [4]) = false then begin
writeln ('Error (line ', LP, '): references must be alphanumeric');
halt;
end;
//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;
//Store the reference in the table
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;
AddrArg (4);
end;
//Increment the byte pointer

View File

@ -62,13 +62,17 @@ 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.
Address arguments can be either absolute addresses or references to or
relative to a label. Relative references are of the form LABEL +/- N,
the spacing being optional.
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.
Note that the assembler does not check for references to non-existing
labels.
Note that the assembler does not check for addresses or references to
reserved addresses or references to or relative to non-existing labels.
Memory-Mapped Devices
---------------------