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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

278
assembler.pas
View File

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

8
readme.md
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. comment elements are all optional, as is spacing between the arguments.
For the arguments of each instruction see the previous section. 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. In addition to the true instructions there are two pseudo-instructions.
ORG defines the starting address of the program: it can only occur as 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 first instruction and cannot have a label, and is not required if
the starting address is 0. DATA introduces a byte of data. the starting address is 0. DATA introduces a byte of data.
Note that the assembler does not check for references to non-existing Note that the assembler does not check for addresses or references to
labels. reserved addresses or references to or relative to non-existing labels.
Memory-Mapped Devices Memory-Mapped Devices
--------------------- ---------------------