{ X86toGAS - (c) 1997 by Peter 'NoWonder' Schneider-Kamp
  modify and distribute freely, but give credits
  no warranty taken for any damage, use at your own risk}

program X86toGAS;

  uses
    crt,dos;

  const
    spas = 0;
    satt = 1;
    sasm = 2;
    sstrh = 3;
    sstrg = 4;
    scomz = 5;
    scomk = 6;
    status:byte = spas;
    laststat:byte = spas;
    togglemode:boolean = false;
    pointit:byte = 0;
    lll:longint = 0;
    maxop = 128;
    maxreg = 4*8;
    regs:array [1..maxreg,1..2] of string[3] = (('eax','l'),('ax','w'),('ah','b'),('al','b'),
                                           ('ebx','l'),('bx','w'),('bh','b'),('bl','b'),
                                           ('ecx','l'),('cx','w'),('ch','b'),('cl','b'),
                                           ('edx','l'),('dx','w'),('dh','b'),('dl','b'),
                                           ('esi','l'),('si','w'),('edi','l'),('di','b'),
                                           ('ebp','l'),('bp','w'),('esp','l'),('sp','w'),
                                           ('cs','w'),('ds','w'),('es','w'),('fs','w'),
                                           ('gs','w'),('ss','w'),('eip','l'),('ip','w'));
    maxconv = 3;
    conv:array [1..maxconv,1..2] of string[8] = (('db','.byte'),
                                              ('dw','.word'),
                                              ('dd','.long'));
    fcmax = 2;
    files:array [1..fcmax] of byte = (0,0);
    ocmax = 1;
    options:array [1..ocmax] of boolean = (false);
    ohelp = 1;
    optionstr:array [1..ocmax] of string = ('-h');
    paramerror:array [1..4] of string = ('too many parameters!',
                                         'no file parameter!',
                                         'too many file parameters!',
                                         'too many options!');
  var
    s,d:text;
    sname,dname:string;
    tempfile:boolean;
    result:byte;
    stackit:array [1..255] of byte;

  procedure pushit(wert:byte);
  begin
    if pointit<255 then begin
      inc(pointit);
      stackit[pointit]:=wert;
    end else writeln('Stack Overflow ...hehe');
  end;

  procedure popit(var wert:byte);
  begin
    if pointit>0 then begin
      wert:=stackit[pointit];
      dec(pointit);
    end else writeln('Stack Underflow ...haha');
  end;

  function chdown(ch:char):char;
  begin
    case ch of
      '�':ch:='�';
      '�':ch:='�';
      '�':ch:='�';
      'A'..'Z':ch:=chr(ord(ch)+ord('a')-ord('A'));
    end;
    chdown:=ch;
  end;

  function strdown(temp:string):string;

    var
      i:byte;

  begin
    for i:=1 to length(temp) do temp[i]:=chdown(temp[i]);
    strdown:=temp;
  end;

  procedure header;
  begin
    ClrScr;
    writeln(^J,'X86toGAS v0.01�',^J);
  end;

  procedure syntax;
  begin
    writeln(^J,'X86toGAS source.file destination.file [-h]',^J);
    writeln(' -h : diese tolle Syntax',^J);
    writeln('Wird nur der source.file angegeben, so wird eine tempor�re ',#13#10,
            'Datei $$$$$$$$.$$$ als destination angelegt und hinterher ',#13#10,
            'nach source.file umbenannt.');
  end;

  procedure trailer;
  var
    result:integer;
  begin
{$I-}
    close(s);
    close(d);
    if tempfile then begin
      write('Renaming $$$$$$$$.$$$ --> ',sname,' ... ');
      erase(s);
      result:={abs}(ioresult);
      rename(d,sname);
      result:=result+{abs}(ioresult);
      if result=0 then
        writeln('OK!')
      else begin
        writeln('Error #',result,' - file not renamed!');
        halt(5);
      end;
    end;
{$I+}
    halt(0);
  end;

  function checkparams:byte;

    var
      i,j,fc,oc:byte;
      option:boolean;

  begin
    tempfile:=false;
    fc:=0;
    oc:=0;
    for i:=1 to paramcount do begin
      option:=false;
      for j:=1 to ocmax do if paramstr(i)=optionstr[j] then begin
        if oc<ocmax then options[j]:=true;
        option:=true;
      end;
      if option then inc(oc) else begin
        inc(fc);
        if fc<=fcmax then files[fc]:=i;
      end;
    end;
    if options[ohelp] then begin
      checkparams:=0;
    end else begin
      if (fc+oc)<paramcount then checkparams:=1 else begin
        if fc=0 then checkparams:=2 else begin
          if fc>fcmax then checkparams:=3 else begin
            if oc>ocmax then checkparams:=4 else begin
              sname:=paramstr(files[1]);
              if fc=1 then begin
                dname:='$$$$$$$$.$$$';
                tempfile:=true;
              end else dname:=paramstr(files[2]);
              checkparams:=0;
            end;
          end;
        end;
      end;
    end;
  end;

  function checkfile:byte;
  begin
    assign(s,sname);
{$I-}
    reset(s);
{$I+}
    checkfile:=ioresult;
  end;

  function createfile:byte;
  begin
    assign(d,dname);
{$I-}
    rewrite(d);
{$I+}
    createfile:=ioresult;
  end;

  function parsefile:byte;

    const
      maxelements = 128;


    type
      telement = record
        pos:byte;
        typ:char;
        text:string;
      end;
      tzeile = record
        text:string;
        befehl,prefix:telement;
        opc,komc:byte;
        operand:array [1..maxelements] of telement;
      end;

    var
      zeile:tzeile;

    procedure parseline;

      var
        temp,info:string;
        i,j:byte;
        keyword:byte;
        vorkommentar,vorstring:byte;

      procedure convert;

        var
          pos,j:byte;
          dbarray:boolean;

        procedure endgapk(var temp:string);
        begin
          while (temp[pos]=',') and (chr(pos)<=temp[0]) do inc(pos);
        end;

        procedure endwordk(var temp:string);
        begin
          while (temp[pos]<>',') and (chr(pos)<=temp[0]) do inc(pos);
        end;

        procedure endgap(var temp:string);
        begin
          while (temp[pos]=' ') and (chr(pos)<=temp[0]) do inc(pos);
        end;

        procedure endword(var temp:string);
        begin
          while (temp[pos]<>' ') and (chr(pos)<=temp[0]) do inc(pos);
        end;

        procedure parseop(var op:telement);
        var
          i:byte;
          override:boolean;
          procedure regpos(var temp:string;var typ:char;x:byte);
          var
            i:byte;
          begin
            temp:=#32+temp+#32;
            for i:=2 to length(temp)-1 do begin
              if copy(temp,i,length(regs[x,1]))=regs[x,1] then if (temp[i-1] in ['*','+','-','[',']',' ',',',#9,':']) and
                 (temp[i+length(regs[x,1])] in ['*','+','-','[',']',' ',',',#9,':'])
                then begin
                  insert('%',temp,i);
                  if not override then typ:=regs[x,2][1];
                end;
            end;
            temp:=copy(temp,2,length(temp)-2);
          end;

          procedure immpos(var temp:string);
          var
            i,j:byte;
            incomplex:boolean;
          begin
            temp:=#32+temp+#32;
            incomplex:=false;
            for i:=2 to length(temp)-1 do begin
              j:=i;
              if temp[i]='[' then incomplex:=true else if temp[i]=']' then incomplex:=false;
              if (temp[i] in ['0'..'9']) and (temp[i-1] in ['*','+','-','[',']',' ',',',#9]) then begin
                while not (temp[j] in ['*','+','-','[',']',' ',',',#9]) do inc(j);
                case temp[j-1] of
                  'h':begin
                        delete(temp,j-1,1);
                        insert('0x',temp,i);
                      end;
                  'd':delete(temp,j-1,1);
                end;
                if not incomplex then insert('$',temp,i);
                while not (temp[j] in ['*','+','-','[',']',' ',',',#9]) do inc(j);
              end else if temp[i]='$' then begin
                insert('0x',temp,i+1);
                while not (temp[j] in ['*','+','-','[',']',' ',',',#9]) do inc(j);
                if (temp[i-1] in ['[']) or (temp[j] in [']']) then delete(temp,i,1);
              end;
            end;
            temp:=copy(temp,2,length(temp)-2);
          end;

          procedure complexpos(var temp:string);

            var
              i,merk,merkl,merkr:byte;
              incomplex:boolean;
              sik:string;

          begin
            incomplex:=false;
            merkr:=0;
            merkl:=0;
            merk:=0;
            for i:=1 to length(temp) do begin
              if temp[i]='[' then begin incomplex:=true; merkl:=i end else
              if temp[i]=']' then begin incomplex:=false; merkr:=i end else
              if incomplex then case temp[i] of
                '+':begin
                  if temp[i+1]='%' then temp[i]:=',' else merk:=i;
                end;
                '-':merk:=i;
                '*':temp[i]:=',';
                '$':begin
                  delete(temp,i,1);
                  i:=i-1;
                end;
              end;
            end;
            if (merkr>0) and (merkl>0) and (merk>0) then begin
              sik:=copy(temp,merk,merkr-merk);
              if sik[1]='+' then delete(sik,1,1);
              delete(temp,merk,merkr-merk);
              temp:=copy(temp,1,merkl-1)+sik+copy(temp,merkl,length(temp)-merkl+1);
            end;
            if not override then op.typ:=#0;
          end;
        begin
          with op do begin
            while (ord(text[0])>0) and (text[1] in [' ','@']) do delete(text,1,1);
            for i:=2 to length(text) do if i<=ord(text[0]) then if text[i]=' ' then if text[i-1]=' ' then delete(text,i,1);
            override:=false;
            if copy(text,1,9)='byte ptr ' then begin
              delete(text,1,9);
              typ:='b';
              override:=true;
            end;
            if copy(text,1,9)='word ptr ' then begin
              delete(text,1,9);
              typ:='w';
              override:=true;
            end;
            if copy(text,1,10)='dword ptr ' then begin
              delete(text,1,10);
              typ:='l';
              override:=true;
            end;
            for i:=1 to maxreg do begin
              regpos(text,typ,i);
            end;
            immpos(text);
            complexpos(text);
            for i:=1 to length(text) do if text[i]='[' then text[i]:='(' else if text[i]=']' then text[i]:=')';
          end;
        end;

        function spaceme(x:integer):string;
        var
          temp:string;
          i:byte;
        begin
          temp:='';
          for i:=1 to x do temp:=temp+' ';
          spaceme:=temp;
        end;

        procedure parsebe;

          var
            i:byte;

        begin
          with zeile.befehl do begin
            for i:=1 to 3 do if zeile.operand[i].typ<>#0 then typ:=zeile.operand[i].typ;
            if typ<>#0 then text:=text+typ;
          end;
        end;

      begin
        i:=1;
        while (i<=ord(temp[0])) do begin
          while (i<=ord(temp[0])) and ((info[i]>=chr(scomz+48)) or (info[i]>chr(sasm+48)) and (vorstring>=scomz)) do begin
            delete(temp,i,1);
            delete(info,i,1);
          end;
          inc(i);
        end;
        with zeile do begin
          pos:=1;
          endgap(temp);
          befehl.pos:=pos;
          befehl.typ:=#0;
          endword(temp);
          befehl.text:=strdown(copy(temp,befehl.pos,pos-befehl.pos));
          while (befehl.text[0]>#0) and (befehl.text[1] in [' ','@']) do delete(befehl.text,1,1);
          fillchar(operand,sizeof(operand),#0);
          endgap(temp);
          operand[1].pos:=pos;
          operand[1].typ:=#0;
          endwordk(temp);
          operand[1].text:=strdown(copy(temp,operand[1].pos,pos-operand[1].pos));
          opc:=ord(operand[1].text[0]>#0);

          while pos<ord(temp[0]) do begin
            inc(opc);
            endgapk(temp);
            operand[opc].pos:=pos;
            operand[opc].typ:=#0;
            endwordk(temp);
            operand[opc].text:=strdown(copy(temp,operand[opc].pos,pos-operand[opc].pos));
          end;

          for pos:=1 to opc do parseop(operand[pos]);
          parsebe;

          dbarray:=false;
          for pos:=1 to maxconv do if befehl.text=conv[pos,1] then begin
            befehl.text:=conv[pos,2];
            if pos<=3 then for j:=1 to opc do delete(operand[j].text,1,1);
            dbarray:=true;
          end;
          if befehl.text[1]='j' then if operand[1].text[1]='$' then operand[1].text[1]:='*';
          temp:=spaceme(befehl.pos-1)+befehl.text;
          if length(befehl.text)<7 then temp:=temp+spaceme(7-length(befehl.text));
          temp:=temp+#32;
          if opc>0 then begin
            if dbarray then begin
              for pos:=1 to opc-1 do temp:=temp+operand[pos].text+',';
              temp:=temp+operand[opc].text;
            end else begin
              for pos:=opc downto 2 do temp:=temp+operand[pos].text+',';
              temp:=temp+operand[1].text;
            end;
          end;
        end;
        zeile.text:=temp;
      end;

    begin
      temp:=zeile.text;
      fillchar(info,sizeof(info),0);
      info[0]:=temp[0];
      togglemode:=false;
      keyword:=0;
      for i:=1 to length(temp) do begin
        laststat:=status;
        case temp[i] of

          '{':if status<=sasm then begin
            pushit(status);
            vorkommentar:=status;
            status:=scomk;
          end else if status>=scomk then begin
            pushit(status);
            inc(status);
          end;

          '}':if status>=scomk then begin
            popit(status);
            info[i]:=chr(laststat+48);
          end else if status<sstrh then begin
            write(#13#10,'Warning! Comment not opened in line ',lll,' column ',i,#13#10,temp);
            gotoxy(i,wherey);readkey;
          end;

          '''':if status=sstrh then begin
            if (i<ord(temp[0])) and (temp[i+1]='''') then begin
              info[i]:=chr(status+48);
              i:=i+1;
            end else begin
              popit(status);
              info[i]:=chr(laststat+48);
            end;
          end else if (status<sstrh) or (status>sstrg) then begin
            pushit(status);
            vorstring:=status;
            status:=sstrh;
          end;
          '"':if status=sstrg then begin
            if (i<ord(temp[0])) and (temp[i+1]='"') then begin
              info[i]:=chr(status+48);
              i:=i+1;
            end else begin
              popit(status);
              info[i]:=chr(laststat+48);
            end;
          end else if (status<sstrh) or (status>sstrh) then begin
            pushit(status);
            vorstring:=status;
            status:=sstrg;
          end;

          '%':begin
            if (length(temp)=i+3) or ((length(temp)>i+3) and (temp[i+4] in [' ',#9,';'])) then
            if (i=1) or ((i>1) and (temp[i-1] in [' ',#9,';'])) then begin
              if (status=spas) and (strdown(copy(temp,i,4))='%asm') then begin
                pushit(status);
                status:=sasm;
                keyword:=i;
              end else if (status=sasm) and (strdown(copy(temp,i,4))='%end') then begin
                popit(status);
                keyword:=i;
              end;
            end;
            if (keyword=0) and (status in [spas,sasm]) then begin
              togglemode:=true;
              for j:=1 to (i-1) do togglemode:=temp[j] in [' ',#9];
              if togglemode then keyword:=i;
            end;
          end;

        end;
        if info[i]=#0 then info[i]:=chr(status+48);
      end;
      if status in [sstrg,sstrh] then writeln('String constant exceeds line!');
      if keyword>0 then begin
        delete(temp,keyword,1);
        delete(info,keyword,1);
        delete(zeile.text,keyword,1);
      end;
      if togglemode and (status=spas) or not togglemode and ((status=sasm) or ((status>=sasm)) and (vorkommentar=sasm))
        and (keyword=0) then convert;
    end;

  begin
    while not eof(s) do begin
      readln(s,zeile.text);
      inc(lll);
      parseline;
      writeln(d,zeile.text);
    end;
    parsefile:=status;
  end;

begin
  Header;

  write('Checking command line parameters ... ');
  result:=checkparams;
  if result=0 then begin
    writeln('OK!');
  end else begin
    writeln('Error #',result,' - ',paramerror[result]);
    Syntax;
    halt(1);
  end;
  if options[ohelp] then begin
    Syntax;
    halt(255);
  end;

  write('Checking for source file ',sname,' ... ');
  result:=checkfile;
  if result=0 then begin
    writeln('OK!');
  end else begin
    writeln('Error #',result,' - file not found: ',sname,'!');
    halt(2);
  end;

  write('Creating ');
  if tempfile then write('temporary') else write('destination');
  write(' file ',dname,' ... ');
  result:=createfile;
  if result=0 then begin
    writeln('OK!');
  end else begin
    write('Error #',result,' - cannot create');
    if tempfile then writeln(' temp file $$$$$$$$.$$$!')
                else writeln(': ',dname,'!');
    halt(3);
  end;

  write('Parsing ',sname,' --> ',dname,' ... ');
  result:=parsefile;
  if result=0 then begin
    writeln('OK!');
  end else begin
    writeln('Error #',result,' - error in source file!');
    halt(4);
  end;

  Trailer;
end.