program gasm;
uses gasmdef, strip, Classes, SysUtils, dtypes;
type
Asm_Statement = class
lineNum : integer;
end;
Asm_Line = class(Asm_Statement)
opcode : integer;
attr : string;
code : array of char;
displ : integer;
end;
Asm_Jump = class(Asm_Statement)
opcode : integer;
lbl : string;
addr : integer;
end;
Asm_Label = class(Asm_Statement)
lbl : string;
addr : integer;
end;
Symbol = class
id : string;
lbl : string;
addr : integer;
end;
var
lineNum, codeSize, dataSize : integer;
input : textfile;
output : file;
statements, symbols : GDLinkedList;
errors : boolean;
procedure asmError(lineNum : integer; msg : string);
begin
writeln('error (line ', lineNum, '): ', msg);
errors := true;
end;
function getLine : string;
var
look : string;
begin
inc(lineNum);
readln(input, look);
Result := look;
end;
function readLine : Asm_Statement;
var
statement, keyword, rhs : string;
a, opcode : integer;
sym : Symbol;
begin
Result := nil;
statement := getLine();
opcode := -1;
if (length(statement) = 0) then
exit;
keyword := left(statement, ' ');
rhs := right(statement, ' ');
if (keyword = '$DATA') then
begin
dataSize := StrToIntDef(rhs, 0);
exit;
end;
if (keyword = '$SYMBOL') then
begin
sym := Symbol.Create;
sym.id := left(rhs, ' ');
sym.lbl := right(rhs, ' ');
symbols.insertLast(sym);
exit;
end;
if (keyword[length(keyword)] = ':') then
begin
Result := Asm_Label.Create;
Asm_Label(Result).lbl := left(keyword, ':');
Asm_Label(Result).lineNum := lineNum;
exit;
end;
for a := 1 to opcodeNum do
begin
if (opcodes[a].keyword = keyword) then
begin
opcode := opcodes[a].opcode;
break;
end;
end;
if (opcode = -1) then
begin
asmError(lineNum, 'illegal opcode ' + keyword);
exit;
end;
case opcode of
_JMP, _JZ, _JNZ,
_CALL : begin
Result := Asm_Jump.Create;
Asm_Jump(Result).lbl := rhs;
Asm_Jump(Result).opcode := opcode;
Asm_Jump(Result).lineNum := lineNum;
end;
else begin
Result := Asm_Line.Create;
Asm_Line(Result).attr := rhs;
Asm_Line(Result).opcode := opcode;
Asm_Line(Result).lineNum := lineNum;
end;
end;
end;
procedure optimize;
var
node, node_next : GListNode;
stat : Asm_Statement;
line : Asm_Line;
begin
node := statements.head;
while (node <> nil) do
begin
node_next := node.next;
stat := node.element;
if (not (stat is Asm_Line)) then
begin
node := node_next;
continue;
end;
line := Asm_Line(stat);
node := node_next;
end;
end;
procedure genCode;
var
b, displ : integer;
f : single;
stat : Asm_Statement;
line : Asm_Line;
jump : Asm_Jump;
lbl : Asm_Label;
node, node_in : GListNode;
sym : Symbol;
begin
displ := 0;
node := statements.head;
while (node <> nil) do
begin
stat := node.element;
if (stat is Asm_Line) then
begin
line := Asm_Line(stat);
case line.opcode of
_PUSHI : begin
line.displ := 5;
setLength(line.code, 4);
b := StrToInt(line.attr);
move(b, line.code[0], 4);
end;
_PUSHF : begin
line.displ := 5;
setLength(line.code, 4);
val(line.attr, f, b);
move(f, line.code[0], 4);
end;
_PUSHS : begin
line.displ := length(line.attr) + 2;
setLength(line.code, length(line.attr) + 1);
for b := 1 to length(line.attr) do
line.code[b - 1] := line.attr[b];
line.code[length(line.attr)] := #0;
end;
_PUSHDISP : begin
b := StrToInt(line.attr);
line.displ := 5;
setLength(line.code, 4);
move(b, line.code[0], 4);
end;
_POPDISP : begin
b := StrToInt(line.attr);
line.displ := 5;
setLength(line.code, 4);
move(b, line.code[0], 4);
end;
_PUSHR : begin
b := StrToInt(right(line.attr, 'R'));
line.displ := 5;
setLength(line.code, 4);
move(b, line.code[0], 4);
end;
_POPR : begin
b := StrToInt(right(line.attr, 'R'));
line.displ := 5;
setLength(line.code, 4);
move(b, line.code[0], 4);
end;
_MTSD : begin
b := StrToInt(right(line.attr, 'R'));
line.displ := 5;
setLength(line.code, 4);
move(b, line.code[0], 4);
end;
_CALLE : begin
line.displ := length(line.attr) + 2;
setLength(line.code, length(line.attr) + 1);
for b := 1 to length(line.attr) do
line.code[b - 1] := line.attr[b];
line.code[length(line.attr)] := #0;
end;
_ADDSP : begin
line.displ := 5;
setLength(line.code, 4);
b := StrToInt(line.attr);
move(b, line.code[0], 4);
end;
_SUBSP : begin
line.displ := 5;
setLength(line.code, 4);
b := StrToInt(line.attr);
move(b, line.code[0], 4);
end;
else
begin
setlength(line.code, 0);
line.displ := 1;
end;
end;
inc(displ, line.displ);
end
else
if (stat is Asm_Label) then
begin
lbl := Asm_Label(stat);
lbl.addr := displ;
end
else
if (stat is Asm_Jump) then
inc(displ, 5);
node := node.next;
end;
node := statements.head;
while (node <> nil) do
begin
stat := node.element;
if (stat is Asm_Jump) then
begin
jump := Asm_Jump(stat);
jump.addr := -1;
node_in := statements.head;
while (node_in <> nil) do
begin
if (not (Asm_Statement(node_in.element) is Asm_Label)) then
begin
node_in := node_in.next;
continue;
end;
lbl := Asm_Label(node_in.element);
if (lbl.lbl = jump.lbl) then
begin
jump.addr := lbl.addr;
break;
end;
node_in := node_in.next;
end;
if (jump.addr = -1) then
asmError(jump.lineNum, 'undefined label ' + jump.lbl);
end;
node := node.next;
end;
codeSize := displ;
node := symbols.head;
while (node <> nil) do
begin
sym := node.element;
node_in := statements.head;
while (node_in <> nil) do
begin
if (not (Asm_Statement(node_in.element) is Asm_Label)) then
begin
node_in := node_in.next;
continue;
end;
lbl := Asm_Label(node_in.element);
if (lbl.lbl = sym.lbl) then
begin
sym.addr := lbl.addr;
break;
end;
node_in := node_in.next;
end;
node := node.next;
end;
end;
procedure writeCode;
var
stat : Asm_Statement;
sym : Symbol;
line : Asm_Line;
jump : Asm_Jump;
node : GListNode;
t : byte;
begin
blockwrite(output, codeSize, 4);
blockwrite(output, dataSize, 4);
node := statements.head;
while (node <> nil) do
begin
stat := node.element;
if (stat is Asm_Line) then
begin
line := Asm_Line(stat);
blockwrite(output, line.opcode, 1);
blockwrite(output, line.code[0], length(line.code));
end
else
if (stat is Asm_Jump) then
begin
jump := Asm_Jump(stat);
blockwrite(output, jump.opcode, 1);
blockwrite(output, jump.addr, 4);
end;
node := node.next;
end;
node := symbols.head;
while (node <> nil) do
begin
sym := node.element;
t := length(sym.id);
blockwrite(output, t, 1);
blockwrite(output, sym.id[1], length(sym.id));
blockwrite(output, sym.addr, 4);
node := node.next;
end;
end;
var
root : Asm_Statement;
ifname : string;
ofname : string;
begin
writeln('GASM - GMC ''Elise'' v0.3'#13#10);
errors := false;
if (paramcount < 1) then
begin
writeln('gasm <input file>');
exit;
end;
ifname := paramstr(1);
ofname := ChangeFileExt(ifname, '.cod');
assignfile(input, ifname);
{$I-}
reset(input);
{$I+}
if (IOResult <> 0) then
begin
writeln('Could not open ', ifname);
exit;
end;
statements := GDLinkedList.Create;
symbols := GDLinkedList.Create;
while (not eof(input)) do
begin
root := readLine();
if (root <> nil) then
statements.insertLast(root);
end;
closefile(input);
if (errors) then
exit;
optimize();
if (errors) then
exit;
genCode();
if (errors) then
exit;
assignfile(output, ofname);
{$I-}
rewrite(output, 1);
{$I+}
if (IOResult <> 0) then
begin
writeln('Could not open ', ofname);
exit;
end;
writeCode();
writeln('Saved ', codeSize, ' byte(s) of code, ', dataSize, ' element(s) data.');
closefile(output);
end.