{                         P32 - 32bit Pascal Compiler                       }
{ ------------------------------------------------------------------------- }
{                       Johan Prins - jprins@knoware.nl                     }
{ ========================================================================= }
{ Routines for the assembler writing routines                               }
{                                                  (c) Copyright 1996-1998  }
{                                                                           }
{ ------------------------------------------------------------------------- }

unit P32_asml;

interface

uses P32_asm, P32_tree, P32_prep, P32_scan, P32_err;

const
   AsmLine: longint=0;

   _offset  = -1;
   _nothing = 0;
   _byte    = 1;
   _word    = 2;
   _dword   = 4;
   _qword   = 8;
   _near    = 16;

   Tab    = ^I;

type
   asmnodetype = ( _empty, _label, _string, _opcode);

   operandtype = ( _non, _reg, _mem, _ord, _lab);

   pAsmRecord =  ^AsmRecord;

   tAsmList    = record
                   First : pAsmRecord;
                   Rear  : pAsmRecord;
                 end;

   Operand    = record
                  size : shortint;            {contains operand size of 8, 16, 32 bits}
                  case o: operandtype of
                  _non : ();
                  _reg : (reg: regs);
                  _mem : (loc: location);
                  _ord : (  n: longint);
                  _lab : (lab: string[64]);
                end;

   AsmRecord  = record
                  prev, next: pAsmRecord; {pointers to other records}
                  case a: asmnodetype of
                   _empty: ();
                   _label: (lab: string[64]);
                  _string: (  s: string[127]);
                  _opcode: ( op: opcode_num;  {index # of in opcode table}
                             o1,
                             o2,
                             o3: operand);
                end;
var AsmList: tAsmList;

procedure CreateAsmList;
function  NewAsmEntry: pAsmRecord;
procedure AddAsmEntry(var a: pAsmRecord);
procedure DeleteAsmEntry(var a: pAsmRecord);
procedure RemoveLastAsmEntry;
procedure DestroyAsmList;
procedure DumpAsmList;

procedure emit_label(const lab:string);
procedure emit_string(const s:string);

procedure emit_non(op: opcode_num);
procedure emit_reg(op: opcode_num; s: integer; r: regs);
procedure emit_loc(op: opcode_num; s: integer;var loc: location);
procedure emit_ord(op: opcode_num; s: integer; n:longint);
procedure emit_lab(op: opcode_num; s: integer; const lab:string);

procedure emit_reg_reg(op: opcode_num; s1: integer; r1: regs; s2:integer; r2: regs);
procedure emit_reg_loc(op: opcode_num; s1: integer; r: regs; s2: integer;var loc:location);
procedure emit_reg_ord(op: opcode_num; s1: integer; r: regs; n:longint);

procedure emit_loc_reg(op: opcode_num; s1: integer;var loc:location;s2: integer; r: regs);
procedure emit_loc_loc(op: opcode_num; s1: integer;var loc1: location; s2: integer;var loc2: location);
procedure emit_loc_ord(op: opcode_num; s: integer;var loc: location; n: longint);

function CreateName(var l : location) : string;

implementation

function CreateName(var l : location) : string;
{ Composes a name of the data that's in the location record }
var s : string;

begin
  if l.l=memref then
    begin
      {if l.name<>NIL then s:=l.name^ else s:='';}
      s:=l.name;
      if l.base<>none then if s='' then s:=r[l.base]
                           else s:=s + ' + ' + r[l.base];
      if l.index<>none then begin
                              if s='' then s:=r[l.index]
                              else s:=s + ' + ' + r[l.index];
                              if l.factor>1 then s:=s + ' * ' + Numb(l.factor);
                            end;
      if l.offset<0 then s:=s + ' - ' + Numb(-l.offset)
                    else if l.offset>0 then s:=s + ' + ' + Numb(l.offset);
      s:='['+s+']';
    end
  else
    begin
      s:='';
      if l.base<>none  then if s='' then s:=r[l.base]
                       else s:=s + r[l.index];
      if l.index<>none then begin
                              if s='' then s:=r[l.index]
                              else s:=s + ' + ' + r[l.index];
                              if (l.factor>1) then s:=s + ' * ' + Numb(l.factor);
                            end;
      if l.offset<0 then begin
                           if s='' then s:=Numb(-l.offset)
                           else s:=s + ' - ' + Numb(-l.offset)
                         end
      else if l.offset>0 then begin
                                if s='' then s:=Numb(l.offset)
                                else s:=s + ' + ' + Numb(l.offset)
                              end;
      if l.l=directmem then s:='[fs:'+s+']'
                       else s:='['+s+']';
    end;
  CreateName:=s;
end;

procedure CreateAsmList;
begin
{  if (AsmList.first<>NIL) then Error('asmlist not empty');}
  AsmList.first:=NIL;
  AsmList.rear :=NIL;
end;

function NewAsmEntry: pAsmRecord;
var a: pAsmRecord;
begin
  new(a);
  fillchar(a^, sizeof(a^), 0);
  NewAsmEntry:= a;
end;

procedure AddAsmEntry(var a: pAsmRecord);

var dummy, temp    : pAsmRecord;
    lev: longint;
begin

  temp := a;
  temp^.next := nil;
  temp^.prev := AsmList.Rear;
  If (AsmList.Rear = NIL) then
    begin
      AsmList.First := temp;
      AsmList.Rear := temp;
    end
  else
    begin
      AsmList.Rear^.Next := temp;
      AsmList.Rear := temp;
    end;
end;

procedure DeleteAsmEntry(var a: pAsmRecord);
begin
  if (a^.Next = nil) then
    RemoveLastAsmEntry
  else
    begin
      if (a = AsmList.First) then              {if we're deleting the first node}
        begin
          AsmList.First := AsmList.First^.Next;    {Start list from second node}
          AsmList.First^.Prev := NIL;        {Set new starts previous link}
          Dispose(a);                {Dispose of old first}
          a:=NIL;
        end
      else
        begin
          a^.prev^.next := a^.next;     {Move pointers...}
          a^.next^.prev := a^.prev;
          Dispose(a);          {Dispose of node}
          a:=NIL;
        end;
    end;
end;

procedure RemoveLastAsmEntry;

begin
  if (AsmList.First <>NIL) and (AsmList.Rear<>NIL) then
    if AsmList.First^.next = nil then
      begin
        Dispose(AsmList.First);
        AsmList.First := nil;
        AsmList.Rear := nil;
      end
    else
      begin
        AsmList.Rear := AsmList.Rear^.prev;
        Dispose(AsmList.Rear^.next);
        AsmList.Rear^.next:=Nil;
      end;
end;

procedure DestroyAsmList;
begin
  while AsmList.First <> nil do    {While still nodes left}
    RemoveLastAsmEntry;            {Remove last node}

  AsmList.first:=NIL;              {Reset values}
  AsmList.rear:=NIL;
end;

procedure WriteOperand(var o:operand);
begin
  case o.o of
  _reg: begin
          if o.size=1 then
            begin
              if o.reg=eax then o.reg:=al;
              if o.reg=edx then o.reg:=dl;
              if o.reg=ecx then o.reg:=cl;
              if o.reg=ebx then o.reg:=bl;
            end
          else
            if o.size=2 then
              begin
                if o.reg=eax then o.reg:=ax;
                if o.reg=edx then o.reg:=dx;
                if o.reg=ecx then o.reg:=cx;
                if o.reg=ebx then o.reg:=bx;
              end;
          write(dest^, r[o.reg]);
        end;
  _mem: begin
          case o.size of
           0 : ;
          -1 : write(dest^, asdef.offset);
           1 : write(dest^, asdef.byteptr);
           2 : write(dest^, asdef.wordptr);
           4 : write(dest^, asdef.dwordptr);
           8 : write(dest^, asdef.qwordptr);
          end;
          write(dest^, CreateName(o.loc));
        end;
  _lab: begin
          case o.size of
           0 : ;
          -1 : write(dest^, asdef.offset);
           1 : write(dest^, asdef.byteptr);
           2 : write(dest^, asdef.wordptr);
           4 : write(dest^, asdef.dwordptr);
           8 : write(dest^, asdef.qwordptr);
           _near : write(dest^, asdef.jump_prefix+' ');
          end;
          write(dest^, o.lab);
        end;
  _ord: begin
          case o.size of
           0 : ;
          -1 : write(dest^, asdef.offset);
           1 : write(dest^, asdef.byteptr);
           2 : write(dest^, asdef.wordptr);
           4 : write(dest^, asdef.dwordptr);
           8 : write(dest^, asdef.qwordptr);
          end;
          write(dest^, Numb(o.n));
        end;
  end;
end;

procedure DumpAsmList;
var a: pAsmRecord;
begin
  a:=AsmList.first;
  while a<>NIL do
    begin
      case a^.a of
      _label : WriteLn(dest^, a^.lab,':');
      _string: WriteLn(dest^,'      ', a^.s);
      _opcode: begin
                 Write(dest^,'      ', opcodes[a^.op], TAB);
                 if a^.o1.o<>_non then
                   WriteOperand(a^.o1);
                 if a^.o2.o<>_non then
                   begin
                     Write(dest^,', ');
                     WriteOperand(a^.o2);
                   end;
                 if a^.o3.o<>_non then
                   begin
                     Write(dest^,', ');
                     WriteOperand(a^.o3);
                   end;
                 WriteLn(dest^);
               end;
      end;
      a:=a^.next;
    end;
end;

procedure emit_label(const lab:string);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _label;
  a^.lab:=lab;
  AddAsmEntry(a);
end;

procedure emit_string(const s:string);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _string;
  a^.s:=s;
  AddAsmEntry(a);
end;

procedure emit_non(op: opcode_num);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_non;
  a^.o2.o:=_non;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

procedure emit_reg(op: opcode_num; s: integer;  r: regs);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_reg;
  a^.o1.reg:= r;
  a^.o1.size:=s;
  a^.o2.o:=_non;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

procedure emit_loc(op: opcode_num; s: integer;var loc: location);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_mem;
  a^.o1.loc:= loc;
  a^.o1.size:=s;
  a^.o2.o:=_non;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

procedure emit_ord(op: opcode_num; s: integer; n:longint);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_ord;
  a^.o1.n:= n;
  a^.o1.size:=s;
  a^.o2.o:=_non;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

procedure emit_lab(op: opcode_num; s: integer; const lab:string);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_lab;
  a^.o1.lab:=lab;
  a^.o1.size:=s;
  a^.o2.o:=_non;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

procedure emit_reg_reg(op: opcode_num; s1: integer; r1: regs; s2:integer; r2: regs);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_reg;
  a^.o1.reg:=r1;
  a^.o1.size:=s1;
  a^.o2.o:=_reg;
  a^.o2.reg:=r2;
  a^.o2.size:=s2;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

procedure emit_reg_loc(op: opcode_num; s1: integer; r: regs; s2: integer;var loc:location);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_reg;
  a^.o1.reg:= r;
  a^.o1.size:=s1;
  a^.o2.o:=_mem;
  a^.o2.loc:= loc;
  a^.o2.size:=s2;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

procedure emit_reg_ord(op: opcode_num; s1: integer; r: regs; n:longint);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_reg;
  a^.o1.reg:= r;
  a^.o1.size:=s1;
  a^.o2.o:=_ord;
  a^.o2.n:=n;
  a^.o2.size:=0;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

procedure emit_loc_reg(op: opcode_num; s1: integer;var loc:location;s2: integer; r: regs);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_mem;
  a^.o1.loc:= loc;
  a^.o1.size:=s1;
  a^.o2.o:=_reg;
  a^.o2.reg:= r;
  a^.o2.size:=s2;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

procedure emit_loc_loc(op: opcode_num; s1: integer;var loc1: location; s2: integer;var loc2: location);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_mem;
  a^.o1.loc:= loc1;
  a^.o1.size:=s1;
  a^.o2.o:=_mem;
  a^.o2.loc:= loc2;
  a^.o2.size:=s2;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

procedure emit_loc_ord(op: opcode_num; s: integer;var loc: location; n: longint);
var a: pAsmRecord;
begin
  a:=NewAsmEntry;
  a^.a:= _opcode;
  a^.op:= op;
  a^.o1.o:=_mem;
  a^.o1.loc:=loc;
  a^.o1.size:=s;
  a^.o2.o:=_ord;
  a^.o2.n:= n;
  a^.o3.o:=_non;
  AddAsmEntry(a);
end;

begin
end.
