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:
parent
e2b545afa5
commit
1a3f010dd0
274
assembler.pas
274
assembler.pas
|
@ -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;
|
||||
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
|
||||
|
|
|
@ -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
|
||||
---------------------
|
||||
|
|
Loading…
Reference in New Issue