/
CVS/
boards/CVS/
clans/
gmc/CVS/
help/CVS/
include/CVS/
players/
progs/CVS/
races/CVS/
system/CVS/
text/
text/CVS/
todo/
todo/CVS/
units/CVS/
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.