* moved some tables from ra386*.pas -> i386.pas

  + start of coff writer
  * renamed asmutils unit to rautils

compiler/ag386cof.pas

@@ -0,0 +1,836 @@
+{
+    $Id$
+    Copyright (c) 1996-98 by the FPC development team
+
+    This unit implements an asmoutput class for i386 coff
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{$ifdef TP}
+  {$N+,E+}
+{$endif}
+unit ag386cof;
+
+    interface
+
+    uses cobjects,aasm,assemble;
+
+    type
+      pi386coffasmlist=^ti386coffasmlist;
+      ti386coffasmlist=object(tasmlist)
+        procedure WriteTree(p:paasmoutput);virtual;
+        procedure WriteAsmList;virtual;
+{$ifdef GDB}
+        procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
+{$endif}
+      end;
+
+  implementation
+
+    uses
+      dos,globtype,globals,systems,i386,
+      strings,files,verbose
+{$ifdef GDB}
+      ,gdb
+{$endif GDB}
+      ;
+
+    const
+      line_length = 70;
+
+    var
+{$ifdef GDB}
+      n_line       : byte;     { different types of source lines }
+      linecount,
+      includecount : longint;
+      funcname     : pchar;
+      stabslastfileinfo : tfileposinfo;
+{$endif}
+      lastsec    : tsection; { last section type written }
+      lastsecidx : longint;
+      lastfileinfo : tfileposinfo;
+      infile,
+      lastinfile   : pinputfile;
+
+
+    function double2str(d : double) : string;
+      var
+         hs : string;
+      begin
+         str(d,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         double2str:='0d'+hs
+      end;
+
+    function extended2str(e : extended) : string;
+      var
+         hs : string;
+      begin
+         str(e,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         extended2str:='0d'+hs
+      end;
+
+    function comp2str(d : bestreal) : string;
+      type
+        pdouble = ^double;
+      var
+        c  : comp;
+        dd : pdouble;
+      begin
+      {$ifdef TP}
+         c:=d;
+      {$else}
+         c:=comp(d);
+      {$endif}
+         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
+         comp2str:=double2str(dd^);
+      end;
+
+
+    function getreferencestring(const ref : treference) : string;
+    var
+      s : string;
+    begin
+      if ref.isintvalue then
+       s:='$'+tostr(ref.offset)
+      else
+       begin
+         with ref do
+          begin
+          { have we a segment prefix ? }
+          { These are probably not correctly handled under GAS }
+          { should be replaced by coding the segment override  }
+          { directly! - DJGPP FAQ                              }
+            if segment<>R_DEFAULT_SEG then
+             s:=att_reg2str[segment]+':'
+            else
+             s:='';
+            if assigned(symbol) then
+             s:=s+symbol^;
+            if offset<0 then
+             s:=s+tostr(offset)
+            else
+             if (offset>0) then
+              begin
+                if assigned(symbol) then
+                 s:=s+'+'+tostr(offset)
+                else
+                 s:=s+tostr(offset);
+              end;
+            if (index<>R_NO) and (base=R_NO) then
+             Begin
+               s:=s+'(,'+att_reg2str[index];
+               if scalefactor<>0 then
+                s:=s+','+tostr(scalefactor)+')'
+               else
+                s:=s+')';
+             end
+            else
+             if (index=R_NO) and (base<>R_NO) then
+              s:=s+'('+att_reg2str[base]+')'
+             else
+              if (index<>R_NO) and (base<>R_NO) then
+               Begin
+                 s:=s+'('+att_reg2str[base]+','+att_reg2str[index];
+                 if scalefactor<>0 then
+                  s:=s+','+tostr(scalefactor)+')'
+                 else
+                  s := s+')';
+               end;
+          end;
+       end;
+      getreferencestring:=s;
+    end;
+
+    function getopstr(t : byte;o : pointer) : string;
+    var
+      hs : string;
+    begin
+      case t of
+        top_reg : getopstr:=att_reg2str[tregister(o)];
+        top_ref : getopstr:=getreferencestring(preference(o)^);
+      top_const : getopstr:='$'+tostr(longint(o));
+     top_symbol : begin
+                    hs:='$'+strpas(pchar(pcsymbol(o)^.symbol));
+                    if pcsymbol(o)^.offset>0 then
+                     hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
+                    else
+                     if pcsymbol(o)^.offset<0 then
+                      hs:=hs+tostr(pcsymbol(o)^.offset);
+                    getopstr:=hs;
+                  end;
+      else
+       internalerror(10001);
+      end;
+    end;
+
+
+    function getopstr_jmp(t : byte;o : pointer) : string;
+    var
+      hs : string;
+    begin
+      case t of
+       top_reg : getopstr_jmp:=att_reg2str[tregister(o)];
+       top_ref : getopstr_jmp:='*'+getreferencestring(preference(o)^);
+     top_const : getopstr_jmp:=tostr(longint(o));
+    top_symbol : begin
+                    hs:=strpas(pchar(pcsymbol(o)^.symbol));
+                    if pcsymbol(o)^.offset>0 then
+                     hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
+                    else
+                     if pcsymbol(o)^.offset<0 then
+                      hs:=hs+tostr(pcsymbol(o)^.offset);
+                    getopstr_jmp:=hs;
+                 end;
+      else
+       internalerror(10001);
+      end;
+    end;
+
+
+{****************************************************************************
+                            TI386ATTASMOUTPUT
+ ****************************************************************************}
+
+    const
+      ait_const2str : array[ait_const_32bit..ait_const_8bit] of string[8]=
+       (#9'.long'#9,#9'.short'#9,#9'.byte'#9);
+
+    function ait_section2str(s:tsection;idx:longint):string;
+    begin
+      case s of
+        sec_code : ait_section2str:='.text';
+        sec_data : ait_section2str:='.data';
+         sec_bss : if target_info.target=target_i386_Win32 then
+                    ait_section2str:='.section .bss'
+                   else
+                    ait_section2str:='.bss';
+       sec_idata : ait_section2str:='.section .idata$'+tostr(idx);
+       sec_edata : ait_section2str:='.section .edata';
+      else
+       ait_section2str:='';
+      end;
+{$ifdef GDB}
+      { this is needed for line info in data }
+      funcname:=nil;
+      case s of
+       sec_code : n_line:=n_textline;
+       sec_data : n_line:=n_dataline;
+        sec_bss : n_line:=n_bssline;
+      else
+       n_line:=n_dataline;
+      end;
+{$endif GDB}
+      LastSec:=s;
+      LastSecIdx:=idx;
+    end;
+
+
+{$ifdef GDB}
+      procedure ti386attasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo);
+        var
+          curr_n : byte;
+        begin
+          if not (cs_debuginfo in aktmoduleswitches) then
+           exit;
+        { file changed ? (must be before line info) }
+          if (fileinfo.fileindex<>0) and
+             (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
+           begin
+             infile:=current_module^.sourcefiles^.get_file(fileinfo.fileindex);
+             if includecount=0 then
+              curr_n:=n_sourcefile
+             else
+              curr_n:=n_includefile;
+             if (infile^.path^<>'') then
+              begin
+                AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+
+                  tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
+              end;
+             AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+
+               tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
+             AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
+             inc(includecount);
+           end;
+        { line changed ? }
+          if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
+           begin
+             if (n_line=n_textline) and assigned(funcname) and
+                (target_os.use_function_relative_addresses) then
+              begin
+                AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
+                AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+
+                           target_asm.labelprefix+'l'+tostr(linecount)+' - ');
+                AsmWritePChar(FuncName);
+                AsmLn;
+                inc(linecount);
+              end
+             else
+              AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(fileinfo.line));
+           end;
+          stabslastfileinfo:=fileinfo;
+        end;
+{$endif GDB}
+
+    function getops(p:pai386;var optyp1,optyp2,optyp3:longint):longint;
+
+      function doop(ot:longint;op:pointer):longint;
+      begin
+        case ot of
+          top_reg :
+            begin
+              doop:=reg_2_type[tregister(op)];
+            end;
+        else
+          internalerror(191918);
+        end;
+      end;
+
+    var
+      ops,opx : longint;
+    begin
+      ops:=0;
+      optyp1:=0;
+      optyp2:=0;
+      optyp3:=0;
+      with p^ do
+       begin
+         if opxt=0 then
+          exit;
+         optyp1:=doop(opx and $f,op1);
+         optyp2:=doop((opx shr 4) and $f,op2);
+       end;
+      getops:=ops;
+    end;
+
+
+    procedure ti386coffasmlist.WriteTree(p:paasmoutput);
+    type
+      twowords=record
+        word1,word2:word;
+      end;
+      textendedarray = array[0..9] of byte; { last longint will be and $ffff }
+    var
+      ch       : char;
+      hp       : pai;
+      consttyp : tait;
+      s        : string;
+      found    : boolean;
+      i,pos,l  : longint;
+      e        : extended;
+      calljmp,
+      do_line  : boolean;
+
+      instruc : tasmop;
+      insops  : longint;
+      fits    : boolean;
+      optyp1,
+      optyp2,
+      optyp3  : longint;
+
+    begin
+      if not assigned(p) then
+       exit;
+      do_line:=(cs_debuginfo in aktmoduleswitches) or (cs_asm_source in aktglobalswitches);
+      hp:=pai(p^.first);
+      while assigned(hp) do
+       begin
+         if do_line then
+          begin
+          { I think it is better to write stabs before source line PM }
+{$ifdef GDB}
+          { write stabs }
+            if cs_debuginfo in aktmoduleswitches then
+             begin
+               if not (hp^.typ in  [ait_external,ait_regalloc, ait_regdealloc,ait_stabn,ait_stabs,
+                      ait_label,ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
+                 begin
+                    WriteFileLineInfo(hp^.fileinfo);
+                 end;
+             end;
+{$endif GDB}
+          { load infile }
+            if lastfileinfo.fileindex<>hp^.fileinfo.fileindex then
+             begin
+               infile:=current_module^.sourcefiles^.get_file(hp^.fileinfo.fileindex);
+               { open only if needed !! }
+               if (cs_asm_source in aktglobalswitches) then
+                 infile^.open;
+               { avoid unnecessary reopens of the same file !! }
+               lastfileinfo.fileindex:=hp^.fileinfo.fileindex;
+               { be sure to change line !! }
+               lastfileinfo.line:=-1;
+             end;
+          { write source }
+            if (cs_asm_source in aktglobalswitches) and
+                not (hp^.typ in  [ait_external,ait_stabn,ait_stabs,ait_section,
+                      ait_label,ait_cut,ait_align,ait_stab_function_name]) then
+             begin
+               if (infile<>lastinfile) and assigned(lastinfile) then
+                 begin
+                   AsmWriteLn(target_asm.comment+'['+infile^.name^+']');
+                   lastinfile^.close;
+                 end;
+               if (hp^.fileinfo.line<>lastfileinfo.line) and
+                  (hp^.fileinfo.line<infile^.maxlinebuf) then
+                 begin
+                   if infile^.linebuf^[hp^.fileinfo.line]>=0 then
+                     AsmWriteLn(target_asm.comment+'['+tostr(hp^.fileinfo.line)+'] '+
+                       trimspace(infile^.GetLineStr(hp^.fileinfo.line)));
+                   { set it to a negative value !
+                   to make that is has been read already !! PM }
+                   infile^.linebuf^[hp^.fileinfo.line]:=-infile^.linebuf^[hp^.fileinfo.line]-1;
+                end;
+               lastfileinfo:=hp^.fileinfo;
+               lastinfile:=infile;
+             end;
+          end;
+
+         case hp^.typ of
+      ait_external : ; { external is ignored }
+       ait_comment : Begin
+                       AsmWrite(target_asm.comment);
+                       AsmWritePChar(pai_asm_comment(hp)^.str);
+                       AsmLn;
+                     End;
+{$ifdef DRegAlloc}
+    ait_regalloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' allocated');
+    ait_regdealloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' released');
+{$Else DRegAlloc}
+    ait_regalloc, ait_regdealloc:;
+{$endif DRegAlloc}
+         ait_align : begin
+                        { Fix Align bytes for Go32 which uses empty bits }
+                        l:=pai_align(hp)^.aligntype;
+                        if (target_info.target in [target_i386_GO32V1,target_i386_GO32V2]) then
+                         begin
+                           i:=0;
+                           while l>1 do
+                            begin
+                              l:=l shr 1;
+                              inc(i);
+                            end;
+                           l:=i;
+                         end;
+                        { use correct align opcode }
+                        AsmWrite(#9'.align '+tostr(l));
+                        if pai_align(hp)^.use_op then
+                         AsmWrite(','+tostr(pai_align(hp)^.op));
+                        AsmLn;
+                     end;
+       ait_section : begin
+                       if pai_section(hp)^.sec<>sec_none then
+                        begin
+                          AsmLn;
+                          AsmWriteLn(ait_section2str(pai_section(hp)^.sec,pai_section(hp)^.idataidx));
+                        end;
+                     end;
+     ait_datablock : begin
+                       if pai_datablock(hp)^.is_global then
+                        AsmWrite(#9'.comm'#9)
+                       else
+                        AsmWrite(#9'.lcomm'#9);
+                       AsmWritePChar(pai_datablock(hp)^.name);
+                       AsmWriteLn(','+tostr(pai_datablock(hp)^.size));
+                     end;
+   ait_const_32bit,
+   ait_const_16bit,
+    ait_const_8bit : begin
+                       AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
+                       consttyp:=hp^.typ;
+                       l:=0;
+                       repeat
+                         found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
+                         if found then
+                          begin
+                            hp:=Pai(hp^.next);
+                            s:=','+tostr(pai_const(hp)^.value);
+                            AsmWrite(s);
+                            inc(l,length(s));
+                          end;
+                       until (not found) or (l>line_length);
+                       AsmLn;
+                     end;
+  ait_const_symbol : begin
+                       AsmWrite(#9'.long'#9);
+                       AsmWritePChar(pchar(pai_const(hp)^.value));
+                       AsmLn;
+                     end;
+  ait_const_symbol_offset : begin
+                       AsmWrite(#9'.long'#9);
+                       AsmWritePChar(pai_const_symbol_offset(hp)^.name);
+                       if pai_const_symbol_offset(hp)^.offset>0 then
+                         AsmWrite('+'+tostr(pai_const_symbol_offset(hp)^.offset))
+                       else if pai_const_symbol_offset(hp)^.offset<0 then
+                         AsmWrite(tostr(pai_const_symbol_offset(hp)^.offset));
+                       AsmLn;
+                     end;
+     ait_const_rva : begin
+                       AsmWrite(#9'.rva'#9);
+                       AsmWritePChar(pchar(pai_const(hp)^.value));
+                       AsmLn;
+                     end;
+    ait_real_64bit : AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
+    ait_real_32bit : AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
+ ait_real_extended : begin
+{$ifdef EXTDEBUG}
+                       AsmWriteLn('# workaround for Extended '+extended2str(pai_extended(hp)^.value));
+{$endif}
+                     { Make sure e is a extended type, bestreal could be
+                       a different type (bestreal) !! (PFV) }
+                       e:=pai_extended(hp)^.value;
+                       AsmWrite(#9'.byte'#9);
+                       for i:=0 to 9 do
+                        begin
+                          if i<>0 then
+                           AsmWrite(',');
+                          AsmWrite(tostr(textendedarray(e)[i]));
+                        end;
+                       AsmLn;
+                     end;
+          ait_comp : begin
+                     { comp type is difficult to write so use double }
+                       AsmWriteLn(#9'.double'#9+comp2str(pai_comp(hp)^.value));
+                     end;
+        ait_direct : begin
+                       AsmWritePChar(pai_direct(hp)^.str);
+                       AsmLn;
+{$IfDef GDB}
+                       if strpos(pai_direct(hp)^.str,'.data')<>nil then
+                         n_line:=n_dataline
+                       else if strpos(pai_direct(hp)^.str,'.text')<>nil then
+                         n_line:=n_textline
+                       else if strpos(pai_direct(hp)^.str,'.bss')<>nil then
+                         n_line:=n_bssline;
+{$endif GDB}
+                     end;
+        ait_string : begin
+                       pos:=0;
+                       for i:=1 to pai_string(hp)^.len do
+                        begin
+                          if pos=0 then
+                           begin
+                             AsmWrite(#9'.ascii'#9'"');
+                             pos:=20;
+                           end;
+                          ch:=pai_string(hp)^.str[i-1];
+                          case ch of
+                             #0, {This can't be done by range, because a bug in FPC}
+                        #1..#31,
+                     #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
+                            '"' : s:='\"';
+                            '\' : s:='\\';
+                          else
+                           s:=ch;
+                          end;
+                          AsmWrite(s);
+                          inc(pos,length(s));
+                          if (pos>line_length) or (i=pai_string(hp)^.len) then
+                           begin
+                             AsmWriteLn('"');
+                             pos:=0;
+                           end;
+                        end;
+                     end;
+         ait_label : begin
+                       if (pai_label(hp)^.l^.is_used) then
+                        begin
+                          if pai_label(hp)^.l^.is_data and (cs_smartlink in aktmoduleswitches) then
+                            AsmWriteLn('.globl'#9+lab2str(pai_label(hp)^.l));
+                          AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
+                        end;
+                     end;
+ ait_labeled_instruction : begin
+                       AsmWriteLn(#9+att_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab));
+                     end;
+        ait_symbol : begin
+                       if pai_symbol(hp)^.is_global then
+                        begin
+                          AsmWrite('.globl'#9);
+                          AsmWritePChar(pai_symbol(hp)^.name);
+                          AsmLn;
+                        end;
+                       if target_info.target=target_i386_linux then
+                        begin
+                           AsmWrite(#9'.type'#9);
+                           AsmWritePChar(pai_symbol(hp)^.name);
+                           if assigned(pai(hp^.next)) and
+                              (pai(hp^.next)^.typ in [ait_const_symbol,ait_const_symbol_offset,
+                                 ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock,
+                                 ait_real_64bit,ait_real_32bit,ait_real_extended,ait_comp]) then
+                            AsmWriteLn(',@object')
+                           else
+                            AsmWriteLn(',@function');
+                        end;
+                       AsmWritePChar(pai_symbol(hp)^.name);
+                       AsmWriteLn(':');
+                     end;
+   ait_instruction :
+     begin { writes an instruction, highly table driven }
+       { get local info }
+       instruc:=pai386(hp)^._operator;
+       insops:=getops(pai386(hp),optyp1,optyp2,optyp3);
+       { get the correct instruction from the it table }
+       if itcache^[instruc]<>-1 then
+         i:=itcache^[instruc]
+       else
+         i:=0;
+       fits:=false;
+       while (not fits) do
+        begin
+          if (it[i].i=instruc) and (itcache^[instruc]=-1) then
+           itcache^[instruc]:=i;
+          if (it[i].i=instruc) and (it[i].ops=insops) then
+           begin
+             { first fit }
+             case insops of
+              0 : begin
+                    fits:=true;
+                    break;
+                  end;
+              1 : Begin
+                    if (optyp1 and it[i].o1)<>0 then
+                     Begin
+                       fits:=true;
+                       break;
+                     end;
+                   { I consider sign-extended 8bit value to }
+                   { be equal to immediate 8bit therefore   }
+                   { convert...                             }
+                   if (optyp1 = ao_imm8) then
+                   Begin
+                     { check if this is a simple sign extend. }
+                     if (it[i].o1<>ao_imm8s) then
+                     Begin
+                       fits:=true;
+                       break;
+                     end;
+                   end;
+                 end;
+             2 : if ((optyp1 and it[i].o1)<>0) and
+                  ((optyp2 and it[i].o2)<>0) then
+                  Begin
+                        fits:=true;
+                        break;
+                  end
+                  { if the operands can be swaped }
+                  { then swap them                }
+                  else if ((it[i].m and af_d)<>0) and
+                  ((optyp1 and it[i].o2)<>0) and
+                  ((optyp2 and it[i].o1)<>0) then
+                  begin
+                    fits:=true;
+                    break;
+                  end;
+             3 : if ((optyp1 and it[i].o1)<>0) and
+                  ((optyp2 and it[i].o2)<>0) and
+                  ((optyp3 and it[i].o3)<>0) then
+                  Begin
+                    fits:=true;
+                    break;
+                  end;
+             end; { end case }
+
+           end;
+          if it[i].i=A_NONE then
+           InternalError(191919);
+        end;
+
+      { Old Writer code }
+                       if (pai386(hp)^._operator=A_PUSH) and
+                          (pai386(hp)^.size=S_W) and
+                          (pai386(hp)^.op1t=top_const) then
+                        begin
+{$ifdef EXTDEBUG}
+                          AsmWriteLn('# workaround for pushw'#9+tostr(longint(pai386(hp)^.op1)));
+{$endif}
+                          AsmWriteLn(#9'.byte 0x66,0x68');
+                          AsmWriteLn(#9'.word '+tostr(longint(pai386(hp)^.op1)));
+                        end
+                       else
+                        begin
+                          calljmp:=(pai386(hp)^._operator=A_CALL) or (pai386(hp)^._operator=A_JMP);
+                        { call maybe not translated to calll }
+                          if calljmp then
+                           s:=#9+att_op2str[pai386(hp)^._operator]
+                          else
+                           s:=#9+att_op2str[pai386(hp)^._operator]+att_opsize2str[pai386(hp)^.size];
+                        { process operands }
+                          if pai386(hp)^.op1t<>top_none then
+                           begin
+                           { call and jmp need an extra handling                          }
+                           { this code is only called if jmp isn't a labeled instruction }
+                             if calljmp then
+                              s:=s+#9+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
+                             else
+                              begin
+                                s:=s+#9+getopstr(pai386(hp)^.op1t,pai386(hp)^.op1);
+                                if pai386(hp)^.op3t<>top_none then
+                                 begin
+                                   if pai386(hp)^.op2t<>top_none then
+                                    s:=s+','+getopstr(pai386(hp)^.op2t,
+                                      pointer(longint(twowords(pai386(hp)^.op2).word1)));
+                                    s:=s+','+getopstr(pai386(hp)^.op3t,
+                                    pointer(longint(twowords(pai386(hp)^.op2).word2)));
+                                 end
+                                else
+                                 if pai386(hp)^.op2t<>top_none then
+                                  s:=s+','+getopstr(pai386(hp)^.op2t,pai386(hp)^.op2);
+                              end;
+                           end;
+                          AsmWriteLn(s);
+                        end;
+                     end;
+{$ifdef GDB}
+         ait_stabs : begin
+                       AsmWrite(#9'.stabs ');
+                       AsmWritePChar(pai_stabs(hp)^.str);
+                       AsmLn;
+                     end;
+         ait_stabn : begin
+                       AsmWrite(#9'.stabn ');
+                       AsmWritePChar(pai_stabn(hp)^.str);
+                       AsmLn;
+                     end;
+    ait_force_line : begin
+                        stabslastfileinfo.line:=0;
+                     end;
+ait_stab_function_name:
+                     funcname:=pai_stab_function_name(hp)^.str;
+{$endif GDB}
+           ait_cut : begin
+                     { only reset buffer if nothing has changed }
+                       if AsmSize=AsmStartSize then
+                        AsmClear
+                       else
+                        begin
+                          AsmClose;
+                          DoAssemble;
+                          if pai_cut(hp)^.EndName then
+                           IsEndFile:=true;
+                          AsmCreate;
+                        end;
+                     { avoid empty files }
+                       while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
+                        begin
+                          if pai(hp^.next)^.typ=ait_section then
+                           begin
+                             lastsec:=pai_section(hp^.next)^.sec;
+                             lastsecidx:=pai_section(hp^.next)^.idataidx;
+                           end;
+                          hp:=pai(hp^.next);
+                        end;
+{$ifdef GDB}
+                       { force write of filename }
+                       FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
+                       includecount:=0;
+                       funcname:=nil;
+                       WriteFileLineInfo(hp^.fileinfo);
+{$endif GDB}
+                       if lastsec<>sec_none then
+                         AsmWriteLn(ait_section2str(lastsec,lastsecidx));
+                       AsmStartSize:=AsmSize;
+                     end;
+        ait_marker : ;
+           else
+             internalerror(10000);
+           end;
+           hp:=pai(hp^.next);
+        end;
+      end;
+
+
+    procedure ti386coffasmlist.WriteAsmList;
+    var
+      p:dirstr;
+      n:namestr;
+      e:extstr;
+{$ifdef GDB}
+      fileinfo : tfileposinfo;
+{$endif GDB}
+
+    begin
+{$ifdef EXTDEBUG}
+      if assigned(current_module^.mainsource) then
+       Comment(v_info,'Start writing att-styled assembler output for '+current_module^.mainsource^);
+{$endif}
+
+      LastSec:=sec_none;
+{$ifdef GDB}
+      FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
+{$endif GDB}
+      FillChar(lastfileinfo,sizeof(lastfileinfo),0);
+      LastInfile:=nil;
+
+      if assigned(current_module^.mainsource) then
+       fsplit(current_module^.mainsource^,p,n,e)
+      else
+       begin
+         p:=inputdir;
+         n:=inputfile;
+         e:=inputextension;
+       end;
+    { to get symify to work }
+      AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
+
+{$ifdef GDB}
+      n_line:=n_bssline;
+      funcname:=nil;
+      linecount:=1;
+      includecount:=0;
+      fileinfo.fileindex:=1;
+      fileinfo.line:=1;
+      { Write main file }
+      WriteFileLineInfo(fileinfo);
+{$endif GDB}
+      AsmStartSize:=AsmSize;
+
+      countlabelref:=false;
+      If (cs_debuginfo in aktmoduleswitches) then
+        WriteTree(debuglist);
+      WriteTree(codesegment);
+      WriteTree(datasegment);
+      WriteTree(consts);
+      WriteTree(rttilist);
+      WriteTree(bsssegment);
+      Writetree(importssection);
+      Writetree(exportssection);
+      Writetree(resourcesection);
+      countlabelref:=true;
+
+      AsmLn;
+{$ifdef EXTDEBUG}
+      if assigned(current_module^.mainsource) then
+       comment(v_info,'Done writing att-styled assembler output for '+current_module^.mainsource^);
+{$endif EXTDEBUG}
+    end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1999-01-10 15:37:51  peter
+    * moved some tables from ra386*.pas -> i386.pas
+    + start of coff writer
+    * renamed asmutils unit to rautils
+
+}

compiler/assemble.pas

@@ -94,6 +94,9 @@ uses
   {$ifndef NoAg386Int}
     ,ag386int
   {$endif NoAg386Int}
+  {$ifdef Ag386Cof}
+    ,ag386cof
+  {$endif Ag386Cof}
 {$endif}
 {$ifdef m68k}
   {$ifndef NoAg68kGas}
@@ -472,6 +475,10 @@ var
 begin
   case aktoutputformat of
 {$ifdef i386}
+  {$ifdef Ag386Cof}
+     as_i386_coff :
+       a:=new(pi386coffasmlist,Init);
+  {$endif Ag386Cof}
   {$ifndef NoAg386Att}
      as_i386_o,
      as_i386_o_aout,
@@ -533,7 +540,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.33  1998-12-11 00:02:45  peter
+  Revision 1.34  1999-01-10 15:37:52  peter
+    * moved some tables from ra386*.pas -> i386.pas
+    + start of coff writer
+    * renamed asmutils unit to rautils
+
+  Revision 1.33  1998/12/11 00:02:45  peter
     + globtype,tokens,version unit splitted from globals
 
   Revision 1.32  1998/11/06 09:46:46  pierre

compiler/i386.pas

@@ -24,20 +24,34 @@ unit i386;
 
   interface
 
+  { By default we want everything }
+  {$define ATTOP}
+  {$define INTELOP}
+  {$define ITTABLE}
+
   { We Don't need the intel style opcodes if we don't have a intel
     reader or generator (PFV) }
   {$ifdef NORA386INT}
     {$ifdef NOAG386NSM}
       {$ifdef NOAG386INT}
-        {$define NOINTOP}
+        {$undef INTELOP}
       {$endif}
     {$endif}
   {$endif}
 
+  { We Don't need the AT&T style opcodes if we don't have a AT&T
+    reader or generator (PFV) }
+  {$ifdef NORA386ATT}
+    {$ifdef NOAG386ATT}
+      {$undef ATTOP}
+    {$endif}
+  {$endif}
+
   { We Don't need the it table if no assembler parser is selected }
+  {$define ITTABLE}
   {$ifdef NORA386INT}
     {$ifdef NORA386ATT}
-      {$define NOITTABLE}
+      {.$undef ITTABLE}
     {$endif}
   {$endif}
 
@@ -47,6 +61,57 @@ unit i386;
     const
       extended_size = 10;
 
+      ao_unknown = $0;
+      ao_none = $ff;
+
+      ao_reg8  = $1;  { 8 bit reg }
+      ao_reg16 = $2;  { 16 bit reg }
+      ao_reg32 = $4;  { 32 bit reg }
+      ao_reg     = (ao_reg8 or ao_reg16 or ao_reg32);
+      ao_wordreg = (ao_reg16 or ao_reg32);
+
+      ao_acc    = $8;  { Accumulat or  %al  or  %ax  or  %eax }
+      ao_sreg2  = $10; { 2 bit segment register }
+      ao_sreg3  = $20; { 3 bit segment register }
+      ao_mmxreg = $40; { mmx register }
+
+      ao_floatacc      = $80;  { Float stack top %st(0) }
+      ao_otherfloatreg = $100; { Float register different from st0 }
+      ao_floatreg = ao_otherfloatreg or ao_floatacc; { all float regs }
+
+      ao_imm8  = $200;       { 8 bit immediate }
+      ao_imm8S = $400;       { 8 bit immediate sign extended }
+      ao_imm16 = $800;       { 16 bit immediate }
+      ao_imm32 = $1000;      { 32 bit immediate }
+      ao_imm1  = $2000;      { 1 bit immediate }
+      ao_imm   = (ao_imm8 or ao_imm8S or ao_imm16 or ao_imm32);
+      ao_immunknown = ao_imm32; { for  unknown expressions }
+
+      ao_disp8   = $4000;     { 8 bit displacement (for  jumps) }
+      ao_disp16  = $8000;     { 16 bit displacement }
+      ao_disp32  = $10000;    { 32 bit displacement }
+      ao_disp    = (ao_disp8 or ao_disp16 or ao_disp32);
+      ao_dispunknown = ao_disp32;
+
+      ao_mem8      = $20000;
+      ao_mem16     = $40000;
+      ao_mem32     = $80000;
+      ao_baseindex = $100000;
+      ao_mem     = (ao_disp or ao_mem8 or ao_mem16 or ao_mem32 or ao_baseindex);
+      ao_wordmem = (ao_mem16 or ao_mem32 or ao_disp or ao_baseindex);
+      ao_bytemem = (ao_mem8 or ao_disp or ao_baseindex);
+
+      ao_inoutportreg = $200000; { register to hold in/out port addr = dx }
+      ao_shiftcount   = $400000; { register to hold shift cound = cl }
+      ao_control = $800000;  { Control register }
+      ao_debug   = $1000000; { Debug register }
+      ao_test    = $2000000; { Test register }
+
+      ao_abs32   = $4000000;
+      ao_jumpabsolute = $8000000;
+
+      ao_implicitregister = (ao_inoutportreg or ao_shiftcount or ao_acc or ao_floatacc);
+
     type
        tasmop = (
          A_MOV,A_MOVZX,A_MOVSX,A_LABEL,A_ADD,
@@ -104,42 +169,46 @@ unit i386;
          A_PSUBUSB,A_PSUBUSW,A_PSUBW,A_PUNPCKHBW,A_PUNPCKHDQ,
          A_PUNPCKHWD,A_PUNPCKLBW,A_PUNPCKLDQ,A_PUNPCKLWD,A_PXOR,
          { KNI instructions: (intel katmai) }
-	 A_ADDPS,A_ADDSS,A_ANDNPS,A_ANDNSS,A_ANDPS,A_ANDSS,A_CMPEQPS,A_CMPEQSS,
-	 A_CMPLEPS,A_CMPLESS,A_CMPLTPS,A_CMPLTSS,A_CMPNEQPS,A_CMPNEQSS,
-	 A_CMPNLEPS,A_CMPNLESS,A_CMPNLTPS,A_CMPNLTSS,A_CMPORDPS,A_CMPORDSS,
-	 A_CMPUNORDPS,A_CMPUNORDSS,A_COMISS,A_CVTPI2PS,A_CVTPS2PI,
-	 A_CVTSI2SS,A_CVTTPS2PI,A_CVTTSS2SI,A_DIVPS,A_DIVSS,A_FXRSTOR,A_FXSAVE,
-	 A_LDMXCSR,A_MASKMOVQ,A_MAXPS,A_MAXSS,A_MINPS,A_MINSS,A_MOVAPS,
-	 A_MOVHPS,A_MOVLPS,A_MOVMSKPS,A_MOVNTPS,A_MOVNTQ,A_MOVSS,A_MOVUPS,
-	 A_MULPS,A_MULSS,A_ORPS,A_PAVGB,A_PAVGW,A_PEXTRW,A_PINSRW,A_PMAXSW,
-	 A_PMAXUB,A_PMINSW,A_PMINUB,A_PMOVMSKB,A_PMULHUW,A_PREFETCHNT,
-	 A_PREFETCH0,A_PREFETCH1,A_PREFETCH2,A_PSADBW,A_PSHUFW,A_RCPPS,A_RCPSS,
-	 A_RSQRTPS,A_RSQRTSS,A_SFENCE,A_SHUFPS,A_SQRTPS,A_SQRTSS,A_STMXCSR,
-	 A_SUBPS,A_SUBSS,A_UCOMISS,A_UNPCKHPS,A_UNPCKLPS,A_XORPS,
+         A_ADDPS,A_ADDSS,A_ANDNPS,A_ANDNSS,A_ANDPS,A_ANDSS,A_CMPEQPS,A_CMPEQSS,
+         A_CMPLEPS,A_CMPLESS,A_CMPLTPS,A_CMPLTSS,A_CMPNEQPS,A_CMPNEQSS,
+         A_CMPNLEPS,A_CMPNLESS,A_CMPNLTPS,A_CMPNLTSS,A_CMPORDPS,A_CMPORDSS,
+         A_CMPUNORDPS,A_CMPUNORDSS,A_COMISS,A_CVTPI2PS,A_CVTPS2PI,
+         A_CVTSI2SS,A_CVTTPS2PI,A_CVTTSS2SI,A_DIVPS,A_DIVSS,A_FXRSTOR,A_FXSAVE,
+         A_LDMXCSR,A_MASKMOVQ,A_MAXPS,A_MAXSS,A_MINPS,A_MINSS,A_MOVAPS,
+         A_MOVHPS,A_MOVLPS,A_MOVMSKPS,A_MOVNTPS,A_MOVNTQ,A_MOVSS,A_MOVUPS,
+         A_MULPS,A_MULSS,A_ORPS,A_PAVGB,A_PAVGW,A_PEXTRW,A_PINSRW,A_PMAXSW,
+         A_PMAXUB,A_PMINSW,A_PMINUB,A_PMOVMSKB,A_PMULHUW,A_PREFETCHNT,
+         A_PREFETCH0,A_PREFETCH1,A_PREFETCH2,A_PSADBW,A_PSHUFW,A_RCPPS,A_RCPSS,
+         A_RSQRTPS,A_RSQRTSS,A_SFENCE,A_SHUFPS,A_SQRTPS,A_SQRTSS,A_STMXCSR,
+         A_SUBPS,A_SUBSS,A_UCOMISS,A_UNPCKHPS,A_UNPCKLPS,A_XORPS,
          { 3Dnow instructions: (amd k6-2) }
-	 A_FEMMS,A_PAVGUSB,A_PF2ID,A_PFACC,A_PFADD,A_PFCMPEQ,A_PFCMPGE,
-	 A_PFCMPGT,A_PFMAX,A_PFMIN,A_PFMUL,A_PFRCP,A_PFRCPIT1,A_PFRCPIT2,
-	 A_PFRSQIT1,A_PFRSQRT,A_PFSUB,A_PFSUBR,A_PI2FD,A_PMULHRW,A_PREFETCH,
-	 A_PREFETCHW
+         A_FEMMS,A_PAVGUSB,A_PF2ID,A_PFACC,A_PFADD,A_PFCMPEQ,A_PFCMPGE,
+         A_PFCMPGT,A_PFMAX,A_PFMIN,A_PFMUL,A_PFRCP,A_PFRCPIT1,A_PFRCPIT2,
+         A_PFRSQIT1,A_PFRSQRT,A_PFSUB,A_PFSUBR,A_PI2FD,A_PMULHRW,A_PREFETCH,
+         A_PREFETCHW
          );
     const
-      firstop = A_MOV;
-      lastop  = A_PREFETCHW;
+      firstop = low(tasmop);
+      lastop  = high(tasmop);
+
 
     type
-       { enumeration for registers, don't change order.     }
-       { this enum is used by the register size conversions }
-       tregister = (
-         R_NO,R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI,
+       { enumeration for registers, don't change this }
+       { it's used by the register size converstaions }
+       tregister = (R_NO,
+         R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI,
          R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI,
          R_AL,R_CL,R_DL,R_BL,R_AH,R_CH,R_BH,R_DH,
          { for an easier assembler generation }
          R_DEFAULT_SEG,R_CS,R_DS,R_ES,R_FS,R_GS,R_SS,
          R_ST,R_ST0,R_ST1,R_ST2,R_ST3,R_ST4,R_ST5,R_ST6,R_ST7,
          R_MM0,R_MM1,R_MM2,R_MM3,R_MM4,R_MM5,R_MM6,R_MM7,
-         R_XMM0,R_XMM1,R_XMM2,R_XMM3,R_XMM4,R_XMM5,R_XMM6,R_XMM7
-         );
+         R_XMM0,R_XMM1,R_XMM2,R_XMM3,R_XMM4,R_XMM5,R_XMM6,R_XMM7);
+    const
+       firstreg = low(tregister);
+       lastreg  = high(tregister);
 
+    type
        { S_NO = No Size of operand }
        { S_B  = Byte size operand  }
        { S_W  = Word size operand  }
@@ -159,17 +228,12 @@ unit i386;
        { S_FV  = floating point vector 4*32 bit = 128 bit (for KNI) }
        topsize = (S_NO,S_B,S_W,S_L,S_BW,S_BL,S_WL,
                   S_IS,S_IL,S_IQ,S_FS,S_FL,S_FX,S_D,S_FV);
-       { S_FS and S_FL added
-         S_X renamed to S_FX
-         S_IL added
-         S_S and S_Q renamed to S_IQ and S_IS
-         S_F? means a real load or store or read
-         added to distinguish between longint l suffix like 'movl'
-         and double l suffix 'fldl'
-         distinction needed for intel output !! }
+    const
+       firstopsize = low(topsize);
+       lastopsize  = high(topsize);
 
-       plocation = ^tlocation;
 
+    type
        { information about the location of an operand }
        { LOC_FPUSTACK    FPU stack }
        { LOC_REGISTER    in a processor register }
@@ -179,7 +243,6 @@ unit i386;
        { LOC_FLAGS       boolean results only, flags are set }
        { LOC_CREGISTER   register which shouldn't be modified }
        { LOC_INVALID     added for tracking problems}
-
        tloc = (LOC_INVALID,LOC_FPU,LOC_REGISTER,LOC_MEM,LOC_REFERENCE,LOC_JUMP,
                LOC_FLAGS,LOC_CREGISTER,LOC_MMXREGISTER,LOC_CMMXREGISTER);
 
@@ -187,7 +250,6 @@ unit i386;
                     F_A,F_AE,F_B,F_BE);
 
        preference = ^treference;
-
        treference = record
           base,segment,index : tregister;
           offset : longint;
@@ -198,6 +260,7 @@ unit i386;
           scalefactor : byte;
        end;
 
+       plocation = ^tlocation;
        tlocation = record
           case loc : tloc of
              LOC_MEM,LOC_REFERENCE : (reference : treference);
@@ -230,20 +293,47 @@ unit i386;
           (A_JE,A_JNE,A_JG,A_JL,A_JGE,A_JLE,A_JC,A_JNC,
            A_JA,A_JAE,A_JB,A_JBE);
 
-       flag_2_set : array[F_E..F_BE] of tasmop =        { v-- the GAS didn't know setc }
+       flag_2_set : array[F_E..F_BE] of tasmop =
           (A_SETE,A_SETNE,A_SETG,A_SETL,A_SETGE,A_SETLE,A_SETB,A_SETAE,
            A_SETA,A_SETAE,A_SETB,A_SETBE);
 
-       { operand types }
-       top_none = 0;
-       top_reg = 1;
-       top_ref = 2;
+    const
+       { arrays for size and type determination }
+       reg_2_size: array[firstreg..lastreg] of topsize = (
+         S_NO,S_L,S_L,S_L,S_L,S_L,S_L,S_L,S_L,
+         S_W,S_W,S_W,S_W,S_W,S_W,S_W,S_W,
+         S_B,S_B,S_B,S_B,S_B,S_B,S_B,S_B,
+         { segment register }
+         S_W,S_W,S_W,S_W,S_W,S_W,S_W,
+         { can also be S_S or S_T - must be checked at run-time }
+         S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,
+         S_D,S_D,S_D,S_D,S_D,S_D,S_D,S_D,
+         S_D,S_D,S_D,S_D,S_D,S_D,S_D,S_D
+       );
+
+       { register type definition table for easier searching }
+       reg_2_type:array[firstreg..lastreg] of longint = (
+         ao_none,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,
+         ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,
+         ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,
+         ao_none,ao_sreg2,ao_sreg2,ao_sreg2,ao_sreg3,ao_sreg3,ao_sreg2,
+         ao_floatacc,ao_floatacc,ao_floatreg,ao_floatreg,ao_floatreg,ao_floatreg,
+         ao_floatreg,ao_floatreg,ao_floatreg,ao_mmxreg,ao_mmxreg,ao_mmxreg,ao_mmxreg,
+         ao_mmxreg,ao_mmxreg,ao_mmxreg,ao_mmxreg,ao_mmxreg,ao_mmxreg,ao_mmxreg,ao_mmxreg,
+         ao_mmxreg,ao_mmxreg,ao_mmxreg,ao_mmxreg
+       );
+
+       const_2_type: array[S_NO..S_FS] of longint =
+       (0,ao_imm8,ao_imm16,ao_imm32,0,0,0,ao_imm16,ao_imm32,0,ao_imm32);
 
-       { a constant can be also written as treference }
-       top_const = 3;
 
-       { this is for calls }
-       top_symbol = 4;
+    const
+       { operand types }
+       top_none   = 0;
+       top_reg    = 1;
+       top_ref    = 2;
+       top_const  = 3; { a constant can be also written as treference }
+       top_symbol = 4; { this is for calls }
 
        stack_pointer = R_ESP;
 
@@ -372,96 +462,8 @@ unit i386;
     { generates an help record for constants }
     function newcsymbol(const s : string;l : longint) : pcsymbol;
 
-    const
-       ao_unknown = $0;
-       { 8 bit reg }
-       ao_reg8 = $1;
-       { 16 bit reg }
-       ao_reg16 = $2;
-       { 32 bit reg }
-       ao_reg32 = $4;
-       { see far below for ao_reg const assignment }
-
-       { for push/pop operands }
-       ao_wordreg = (ao_reg16 or ao_reg32);
-       ao_imm8 = $8;        { 8 bit immediate }
-       ao_imm8S   = $10;        { 8 bit immediate sign extended }
-       ao_imm16   = $20;        { 16 bit immediate }
-       ao_imm32   = $40;        { 32 bit immediate }
-       ao_imm1    = $80;        { 1 bit immediate }
-
-       { for unknown expressions }
-       ao_immunknown = ao_imm32;
-
-       { gen'l immediate }
-       ao_imm = (ao_imm8 or ao_imm8S or ao_imm16 or ao_imm32);
-       ao_disp8   = $200;       { 8 bit displacement (for  jumps) }
-       ao_disp16  = $400;       { 16 bit displacement }
-       ao_disp32  = $800;       { 32 bit displacement }
-
-       { general displacement }
-       ao_disp    = (ao_disp8 or ao_disp16 or ao_disp32);
-
-       { for unknown size displacements }
-       ao_dispunknown = ao_disp32;
-       ao_mem8    = $1000;
-       ao_mem16   = $2000;
-       ao_mem32   = $4000;
-       ao_baseindex = $8000;
-
-       { general mem }
-       ao_mem     = (ao_disp or ao_mem8 or ao_mem16 or ao_mem32 or ao_baseindex);
-       ao_wordmem = (ao_mem16 or ao_mem32 or ao_disp or ao_baseindex);
-       ao_bytemem = (ao_mem8 or ao_disp or ao_baseindex);
-
-       { register to hold in/out port addr = dx }
-       ao_inoutportreg = $10000;
-       { register to hold shift cound = cl }
-       ao_shiftcount = $20000;
-       ao_control = $40000; { Control register }
-       ao_debug   = $80000; { Debug register }
-       ao_test    = $100000;    { Test register }
-
-       { suggestion from PM }
-       { st0 is also a float reg }
-
-       {ao_floatreg = $200000;  }{ Float register }
-       ao_otherfloatreg = $200000;  { Float register different from st0 }
-       ao_floatacc = $400000;   { Float stack top %st(0) }
-       ao_floatreg = ao_otherfloatreg or ao_floatacc; { all float regs }
-
-       { Florian correct this if it is wrong
-         but it seems necessary for ratti386 to accept the code
-         in i386/math.inc !! }
-
-       { 2 bit segment register }
-       ao_sreg2   = $800000;
-
-       { 3 bit segment register }
-       ao_sreg3   = $1000000;
-
-       { Accumulat or  %al  or  %ax  or  %eax }
-       ao_acc  = $2000000;
-       ao_implicitregister = (ao_inoutportreg or ao_shiftcount or ao_acc or ao_floatacc);
-       ao_jumpabsolute = $4000000;
-       ao_abs8 = $08000000;
-       ao_abs16 = $10000000;
-       ao_abs32 = $20000000;
-       ao_abs = (ao_abs8 or ao_abs16 or ao_abs32);
-       
-       { packed int or float number, 8*8 bit = 4*16 bit = 2*32 bit = 64 bit 
-         - for MMX and 3DNow! }
-       ao_reg64 = $40000000;
-       { floating point vector, 4*32 bit = 128 bit 
-         - for KNI }
-       ao_reg128 = $80000000;
-
-       { bitmask for any possible register }
-       ao_reg = (ao_reg8 or ao_reg16 or ao_reg32 or ao_reg64 or ao_reg128);
-       
-       ao_none = $ff;
-
 
+    const
        { this is for the code generator }
        { set if operands are words or dwords }
        af_w       = $1;
@@ -497,15 +499,18 @@ unit i386;
           o1,o2,o3 : longint;
        end;
 
-    const
-       last_instruction_in_cache = A_EMMS;
+{$ifdef ITTABLE}
     type
-       tins_cache = array[A_MOV..last_instruction_in_cache] of longint;
+       titcache = array[firstop..lastop] of longint;
+       pitcache = ^titcache;
     var
-       ins_cache : tins_cache;
+       itcache : pitcache;
 
-{$ifndef NOITTABLE}
     const
+       { only tokens up to and including lastop_ittable }
+       { are checked for validity, otherwise...         }
+       lastop_ittable = A_EMMS;
+
        it : array[0..442] of ttemplate = (
          (i : A_MOV;ops : 2;oc : $a0;eb : ao_none;m : af_dw or NoModrm;o1 : ao_disp32;o2 : ao_acc;o3 : 0 ),
          (i : A_MOV;ops : 2;oc : $88;eb : ao_none;m : af_dw or Modrm;o1 : ao_reg;o2 : ao_reg or ao_mem;o3 : 0 ),
@@ -969,9 +974,9 @@ unit i386;
          (i : A_REPE;ops : 0;oc : $f3;eb : ao_none;m : NoModrm;o1 : 0;o2 : 0;o3 : 0),
          (i : A_REPNE;ops : 0;oc : $f2;eb : ao_none;m : NoModrm;o1 : 0;o2 : 0;o3 : 0),
          (i : A_CPUID;ops : 0;oc : $0fa2;eb : ao_none;m : NoModrm;o1 : 0;o2 : 0;o3 : 0),
-         (i : A_EMMS;ops : 0;oc : $0f77;eb : ao_none;m : NoModrm;o1 : 0;o2 : 0;o3 : 0),       
+         (i : A_EMMS;ops : 0;oc : $0f77;eb : ao_none;m : NoModrm;o1 : 0;o2 : 0;o3 : 0),
          { MMX instructions: }
-(* TODO        
+(* TODO
          A_EMMS,A_MOVD,A_MOVQ,A_PACKSSDW,A_PACKSSWB,A_PACKUSWB,
          A_PADDB,A_PADDD,A_PADDSB,A_PADDSW,A_PADDUSB,A_PADDUSW,
          A_PADDW,A_PAND,A_PANDN,A_PCMPEQB,A_PCMPEQD,A_PCMPEQW,
@@ -984,33 +989,34 @@ unit i386;
          { KNI instructions: (intel katmai) }
 (* TODO - add syntax description for these opcodes:
    really required for the first turn??
-	 A_ADDPS,A_ADDSS,A_ANDNPS,A_ANDNSS,A_ANDPS,A_ANDSS,A_CMPEQPS,A_CMPEQSS,
-	 A_CMPLEPS,A_CMPLESS,A_CMPLTPS,A_CMPLTSS,A_CMPNEQPS,A_CMPNEQSS,
-	 A_CMPNLEPS,A_CMPNLESS,A_CMPNLTPS,A_CMPNLTSS,A_CMPORDPS,A_CMPORDSS,
-	 A_CMPUNORDPS,A_CMPUNORDSS,A_COMISS,A_CVTPI2PS,A_CVTPS2PI,
-	 A_CVTSI2SS,A_CVTTPS2PI,A_CVTTSS2SI,A_DIVPS,A_DIVSS,A_FXRSTOR,A_FXSAVE,
-	 A_LDMXCSR,A_MASKMOVQ,A_MAXPS,A_MAXSS,A_MINPS,A_MINSS,A_MOVAPS,
-	 A_MOVHPS,A_MOVLPS,A_MOVMSKPS,A_MOVNTPS,A_MOVNTQ,A_MOVSS,A_MOVUPS,
-	 A_MULPS,A_MULSS,A_ORPS,A_PAVGB,A_PAVGW,A_PEXTRW,A_PINSRW,A_PMAXSW,
-	 A_PMAXUB,A_PMINSW,A_PMINUB,A_PMOVMSKB,A_PMULHUW,A_PREFETCHNT,
-	 A_PREFETCH0,A_PREFETCH1,A_PREFETCH2,A_PSADBW,A_PSHUFW,A_RCPPS,A_RCPSS,
-	 A_RSQRTPS,A_RSQRTSS,A_SFENCE,A_SHUFPS,A_SQRTPS,A_SQRTSS,A_STMXCSR,
-	 A_SUBPS,A_SUBSS,A_UCOMISS,A_UNPCKHPS,A_UNPCKLPS,A_XORPS,
-*)	 
+         A_ADDPS,A_ADDSS,A_ANDNPS,A_ANDNSS,A_ANDPS,A_ANDSS,A_CMPEQPS,A_CMPEQSS,
+         A_CMPLEPS,A_CMPLESS,A_CMPLTPS,A_CMPLTSS,A_CMPNEQPS,A_CMPNEQSS,
+         A_CMPNLEPS,A_CMPNLESS,A_CMPNLTPS,A_CMPNLTSS,A_CMPORDPS,A_CMPORDSS,
+         A_CMPUNORDPS,A_CMPUNORDSS,A_COMISS,A_CVTPI2PS,A_CVTPS2PI,
+         A_CVTSI2SS,A_CVTTPS2PI,A_CVTTSS2SI,A_DIVPS,A_DIVSS,A_FXRSTOR,A_FXSAVE,
+         A_LDMXCSR,A_MASKMOVQ,A_MAXPS,A_MAXSS,A_MINPS,A_MINSS,A_MOVAPS,
+         A_MOVHPS,A_MOVLPS,A_MOVMSKPS,A_MOVNTPS,A_MOVNTQ,A_MOVSS,A_MOVUPS,
+         A_MULPS,A_MULSS,A_ORPS,A_PAVGB,A_PAVGW,A_PEXTRW,A_PINSRW,A_PMAXSW,
+         A_PMAXUB,A_PMINSW,A_PMINUB,A_PMOVMSKB,A_PMULHUW,A_PREFETCHNT,
+         A_PREFETCH0,A_PREFETCH1,A_PREFETCH2,A_PSADBW,A_PSHUFW,A_RCPPS,A_RCPSS,
+         A_RSQRTPS,A_RSQRTSS,A_SFENCE,A_SHUFPS,A_SQRTPS,A_SQRTSS,A_STMXCSR,
+         A_SUBPS,A_SUBSS,A_UCOMISS,A_UNPCKHPS,A_UNPCKLPS,A_XORPS,
+*)
          { 3Dnow instructions: (amd k6-2) }
-(* TODO         
-	 A_FEMMS,A_PAVGUSB,A_PF2ID,A_PFACC,A_PFADD,A_PFCMPEQ,A_PFCMPGE,
-	 A_PFCMPGT,A_PFMAX,A_PFMIN,A_PFMUL,A_PFRCP,A_PFRCPIT1,A_PFRCPIT2,
-	 A_PFRSQIT1,A_PFRSQRT,A_PFSUB,A_PFSUBR,A_PI2FD,A_PMULHRW,A_PREFETCH,
-	 A_PREFETCHW,
-*)	 
+(* TODO
+         A_FEMMS,A_PAVGUSB,A_PF2ID,A_PFACC,A_PFADD,A_PFCMPEQ,A_PFCMPGE,
+         A_PFCMPGT,A_PFMAX,A_PFMIN,A_PFMUL,A_PFRCP,A_PFRCPIT1,A_PFRCPIT2,
+         A_PFRSQIT1,A_PFRSQRT,A_PFSUB,A_PFSUBR,A_PI2FD,A_PMULHRW,A_PREFETCH,
+         A_PREFETCHW,
+*)
          (i : A_NONE));
-{$endif NOITTABLE}
+{$endif ITTABLE}
 
 {****************************************************************************
                             Assembler Mnemoics
 ****************************************************************************}
 
+{$ifdef ATTOP}
     const
       att_op2str : array[firstop..lastop] of string[7] =
        ('mov','movz','movs','','add',
@@ -1066,26 +1072,26 @@ unit i386;
         'psrld','psrlq','psrlw','psubb','psubd','psubsb','psubsw',
         'psubusb','psubusw','psubw','punpckhbw','punpckhdq',
         'punpckhwd','punpcklbw','punpckldq','punpcklwd','pxor',
-        { KNI instructions (intel katmai) 
+        { KNI instructions (intel katmai)
           - sorry, dont know how ATT mnemonics will be called }
-	'addps','addss','andnps','andnss','andps','andss','cmpeqps','cmpeqps',
-	'cmpleps','cmpless','cmpltps','cmpltss','cmpneqps','cmpneqss',
-	'cmpnleps','cmpnless','cmpnltps','cmpnltss','cmpordps','cmpordss',
-	'cmpunordps','cmpunordss','comiss','cvtpi2ps','cvtps2pi','cvtsi2ss',
-	'cvttps2pi','cvttss2si','divps','divss','fxrstor','fxsave','ldmxcsr',
-	'maskmovq','maxps','maxss','minps','minss','movaps','movhps','movlps',
-	'movmskps','movntps','movntq','movss','movups','mulps','mulss','orps',
-	'pavgb','pavgw','pextrw','pinsrw','pmaxsw','pmaxub','pminsw','pminub',
-	'pmovmskb','pmulhuw','prefetchnt','prefetch0','prefetch1','prefetch2',
-	'psadbw','pshufw','rcpps','rcpss','rsqrtps','rsqrtss','sfence',
-	'shufps','sqrtps','sqrtss','stmxcsr','subps','subss','ucomiss',
-	'unpckhps','unpcklps','xorps',
-        { 3Dnow instructions (amd k6-2) 
+        'addps','addss','andnps','andnss','andps','andss','cmpeqps','cmpeqps',
+        'cmpleps','cmpless','cmpltps','cmpltss','cmpneqps','cmpneqss',
+        'cmpnleps','cmpnless','cmpnltps','cmpnltss','cmpordps','cmpordss',
+        'cmpunordps','cmpunordss','comiss','cvtpi2ps','cvtps2pi','cvtsi2ss',
+        'cvttps2pi','cvttss2si','divps','divss','fxrstor','fxsave','ldmxcsr',
+        'maskmovq','maxps','maxss','minps','minss','movaps','movhps','movlps',
+        'movmskps','movntps','movntq','movss','movups','mulps','mulss','orps',
+        'pavgb','pavgw','pextrw','pinsrw','pmaxsw','pmaxub','pminsw','pminub',
+        'pmovmskb','pmulhuw','prefetchnt','prefetch0','prefetch1','prefetch2',
+        'psadbw','pshufw','rcpps','rcpss','rsqrtps','rsqrtss','sfence',
+        'shufps','sqrtps','sqrtss','stmxcsr','subps','subss','ucomiss',
+        'unpckhps','unpcklps','xorps',
+        { 3Dnow instructions (amd k6-2)
           - sorry, dont know how ATT mnemonics are called }
-	 'femms','pavgusb','pf2id','pfacc','pfadd','pfcmpeq','pfcmpge',
-	 'pfcmpgt','pfmax','pfmin','pfmul','pfrcp','pfrcpit1','pfrcpit2',
-	 'pfrsqit1','pfrsqrt','pfsub','pfsubr','pi2fd','pmulhrw','prefetch',
-	 'prefetchw'
+         'femms','pavgusb','pf2id','pfacc','pfadd','pfcmpeq','pfcmpge',
+         'pfcmpgt','pfmax','pfmin','pfmul','pfrcp','pfrcpit1','pfrcpit2',
+         'pfrsqit1','pfrsqrt','pfsub','pfsubr','pi2fd','pmulhrw','prefetch',
+         'prefetchw'
         );
 
      {  topsize = (S_NO,S_B,S_W,S_L,S_BW,S_BL,S_WL,
@@ -1104,10 +1110,10 @@ unit i386;
         '%mm0','%mm1','%mm2','%mm3',
         '%mm4','%mm5','%mm6','%mm7',
         '%xmm0','%xmm1','%xmm2','%xmm3',
-        '%xmm4','%xmm5','%xmm6','%xmm7'
-        );
+        '%xmm4','%xmm5','%xmm6','%xmm7');
+{$endif ATTOP}
 
-{$ifndef NOINTOP}
+{$ifdef INTELOP}
       int_op2str : array[firstop..lastop] of string[9] =
        ('mov','movzx','movsx','','add',
         'call','idiv','imul','jmp','lea','mul','neg','not',
@@ -1163,23 +1169,23 @@ unit i386;
         'psubusb','psubusw','psubw','punpckhbw','punpckhdq',
         'punpckhwd','punpcklbw','punpckldq','punpcklwd','pxor',
         { KNI instructions (intel katmai) }
-	'addps','addss','andnps','andnss','andps','andss','cmpeqps','cmpeqps',
-	'cmpleps','cmpless','cmpltps','cmpltss','cmpneqps','cmpneqss',
-	'cmpnleps','cmpnless','cmpnltps','cmpnltss','cmpordps','cmpordss',
-	'cmpunordps','cmpunordss','comiss','cvtpi2ps','cvtps2pi','cvtsi2ss',
-	'cvttps2pi','cvttss2si','divps','divss','fxrstor','fxsave','ldmxcsr',
-	'maskmovq','maxps','maxss','minps','minss','movaps','movhps','movlps',
-	'movmskps','movntps','movntq','movss','movups','mulps','mulss','orps',
-	'pavgb','pavgw','pextrw','pinsrw','pmaxsw','pmaxub','pminsw','pminub',
-	'pmovmskb','pmulhuw','prefetchnt','prefetch0','prefetch1','prefetch2',
-	'psadbw','pshufw','rcpps','rcpss','rsqrtps','rsqrtss','sfence',
-	'shufps','sqrtps','sqrtss','stmxcsr','subps','subss','ucomiss',
-	'unpckhps','unpcklps','xorps',
+        'addps','addss','andnps','andnss','andps','andss','cmpeqps','cmpeqps',
+        'cmpleps','cmpless','cmpltps','cmpltss','cmpneqps','cmpneqss',
+        'cmpnleps','cmpnless','cmpnltps','cmpnltss','cmpordps','cmpordss',
+        'cmpunordps','cmpunordss','comiss','cvtpi2ps','cvtps2pi','cvtsi2ss',
+        'cvttps2pi','cvttss2si','divps','divss','fxrstor','fxsave','ldmxcsr',
+        'maskmovq','maxps','maxss','minps','minss','movaps','movhps','movlps',
+        'movmskps','movntps','movntq','movss','movups','mulps','mulss','orps',
+        'pavgb','pavgw','pextrw','pinsrw','pmaxsw','pmaxub','pminsw','pminub',
+        'pmovmskb','pmulhuw','prefetchnt','prefetch0','prefetch1','prefetch2',
+        'psadbw','pshufw','rcpps','rcpss','rsqrtps','rsqrtss','sfence',
+        'shufps','sqrtps','sqrtss','stmxcsr','subps','subss','ucomiss',
+        'unpckhps','unpcklps','xorps',
         { 3Dnow instructions (amd k6-2) }
-	 'femms','pavgusb','pf2id','pfacc','pfadd','pfcmpeq','pfcmpge',
-	 'pfcmpgt','pfmax','pfmin','pfmul','pfrcp','pfrcpit1','pfrcpit2',
-	 'pfrsqit1','pfrsqrt','pfsub','pfsubr','pi2fd','pmulhrw','prefetch',
-	 'prefetchw'
+         'femms','pavgusb','pf2id','pfacc','pfadd','pfcmpeq','pfcmpge',
+         'pfcmpgt','pfmax','pfmin','pfmul','pfrcp','pfrcpit1','pfrcpit2',
+         'pfrsqit1','pfrsqrt','pfsub','pfsubr','pi2fd','pmulhrw','prefetch',
+         'prefetchw'
         );
 
      int_reg2str : array[tregister] of string[5] =
@@ -1201,7 +1207,7 @@ unit i386;
         'mm0','mm1','mm2','mm3','mm4','mm5','mm6','mm7',
         'xmm0','xmm1','xmm2','xmm3','xmm4','xmm5','xmm6','xmm7'
         );
-{$endif}
+{$endif INTELOP}
 
 
   implementation
@@ -1886,10 +1892,39 @@ unit i386;
         inherited done;
       end;
 
+
+{****************************************************************************
+                              Initialize
+****************************************************************************}
+
+var
+  old_exit: pointer;
+procedure i386_exit;{$ifndef FPC}far;{$endif}
+begin
+{$ifdef ITTABLE}
+  dispose(itcache);
+{$endif}
+  exitproc:=old_exit;
+end;
+
+
+Begin
+{$ifdef ITTABLE}
+  { create the itcache and reset to -1 }
+  new(itcache);
+  FillChar(ItCache^,sizeof(titcache),$ff);
+{$endif}
+  old_exit := exitproc;
+  exitproc := @i386_exit;
 end.
 {
   $Log$
-  Revision 1.26  1999-01-08 12:39:24  florian
+  Revision 1.27  1999-01-10 15:37:53  peter
+    * moved some tables from ra386*.pas -> i386.pas
+    + start of coff writer
+    * renamed asmutils unit to rautils
+
+  Revision 1.26  1999/01/08 12:39:24  florian
     Changes of Alexander Stohr integrated:
       + added KNI opcodes
       + added KNI registers

compiler/ra386att.pas

@@ -61,10 +61,6 @@ const
  _asmsorted: boolean = FALSE;
  firstreg       = R_EAX;
  lastreg        = R_ST7;
- { Hack to support all opcodes in the i386 table    }
- { only tokens up to and including lastop_in_table  }
- { are checked for validity, otherwise...           }
- lastop_in_table = A_EMMS;
 
 type
  tiasmops = array[firstop..lastop] of string[7];
@@ -81,8 +77,9 @@ var
 Implementation
 
 Uses
-  files,aasm,globals,AsmUtils,strings,hcodegen,scanner,systems,
-  cobjects,verbose,symtable,types;
+  strings,cobjects,systems,verbose,globals,
+  files,aasm,types,symtable,scanner,hcodegen,
+  rautils;
 
 type
  tinteltoken = (
@@ -133,28 +130,6 @@ const
        A_SCAS,A_SCAS,A_SCAS,A_STOS,A_STOS,A_STOS,A_MOVS,A_MOVS,A_MOVS,
        A_LODS,A_LODS,A_LODS,A_LOCK,A_NONE,A_NONE,A_NONE,A_NONE);
      {------------------------------------------------------------------}
-       { register type definition table for easier searching }
-       _regtypes:array[firstreg..lastreg] of longint =
-       (ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,
-       ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,
-       ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,
-       ao_none,ao_sreg2,ao_sreg2,ao_sreg2,ao_sreg3,ao_sreg3,ao_sreg2,
-       ao_floatacc,ao_floatacc,ao_floatreg,ao_floatreg,ao_floatreg,ao_floatreg,
-       ao_floatreg,ao_floatreg,ao_floatreg);
-
-       _regsizes: array[firstreg..lastreg] of topsize =
-       (S_L,S_L,S_L,S_L,S_L,S_L,S_L,S_L,
-        S_W,S_W,S_W,S_W,S_W,S_W,S_W,S_W,
-        S_B,S_B,S_B,S_B,S_B,S_B,S_B,S_B,
-        { segment register }
-        S_W,S_W,S_W,S_W,S_W,S_W,S_W,
-        { can also be S_S or S_T - must be checked at run-time }
-        S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL);
-
-       {topsize = (S_NO,S_B,S_W,S_L,S_BW,S_BL,S_WL,
-                  S_IS,S_IL,S_IQ,S_FS,S_FL,S_FX,S_D);}
-       _constsizes: array[S_NO..S_FS] of longint =
-       (0,ao_imm8,ao_imm16,ao_imm32,0,0,0,ao_imm16,ao_imm32,0,ao_imm32);
 
        { converts from AT&T style to non-specific style... }
        _fpusizes:array[A_FILDQ..A_FIDIVRS] of topsize = (
@@ -929,7 +904,7 @@ var
                        { check if there is not already a default size }
                        if opr.size <> S_NO then
                        Begin
-                          findtype := _constsizes[opr.size];
+                          findtype := const_2_type[opr.size];
                          exit;
                        end;
                        if val < $ff then
@@ -949,7 +924,7 @@ var
                        end
                      end;
        OPR_REGISTER: Begin
-                      findtype := _regtypes[reg];
+                      findtype := reg_2_type[reg];
                       exit;
                      end;
        OPR_SYMBOL:     Begin
@@ -1098,7 +1073,7 @@ var
      Begin
        case instr.operands[i].operandtype of
          OPR_REGISTER: instr.operands[i].size :=
-                         _regsizes[instr.operands[i].reg];
+                         reg_2_size[instr.operands[i].reg];
        end; { end case }
      end; { endif }
     { setup specific instructions for first pass }
@@ -1580,14 +1555,15 @@ var
     { after reading the operands }
     { search the instruction     }
     { setup startvalue from cache }
-    if ins_cache[instruc]<>-1 then
-       i:=ins_cache[instruc]
-    else i:=0;
+    if itcache^[instruc]<>-1 then
+      i:=itcache^[instruc]
+    else
+      i:=0;
 
     { I think this is too dangerous for me therefore i decided that for }
     { the att version only if the processor > i386 or we are compiling  }
     { the system unit then this will be allowed...                      }
-    if (instruc > lastop_in_table) then
+    if (instruc > lastop_ittable) then
       begin
          Message1(assem_w_opcode_not_in_table,upper(att_op2str[instruc]));
          fits:=true;
@@ -1596,8 +1572,8 @@ var
       begin
        { set the instruction cache, if the instruction }
        { occurs the first time                         }
-       if (it[i].i=instruc) and (ins_cache[instruc]=-1) then
-           ins_cache[instruc]:=i;
+       if (it[i].i=instruc) and (itcache^[instruc]=-1) then
+         itcache^[instruc]:=i;
 
        if (it[i].i=instruc) and (instr.numops=it[i].ops) then
        begin
@@ -3103,18 +3079,14 @@ Begin
                 begin
                   expr := actasmpattern;
                   Consume(AS_ID);
-                  case actasmtoken of
-                    AS_DOT:
-                      Begin
-                        GetRecordOffsetSize(expr,toffset,tsize);
-                        inc(instr.operands[operandnum].ref.offset,toffset);
-                        SetOperandSize(instr,operandnum,tsize);
-                      end;
-                    AS_SEPARATOR,
-                    AS_COMMA: ;
-                  else
-                    Message(assem_e_syntax_error);
-                  end; { end case }
+                  if actasmtoken=AS_DOT then
+                   begin
+                     GetRecordOffsetSize(expr,toffset,tsize);
+                     inc(instr.operands[operandnum].ref.offset,toffset);
+                     SetOperandSize(instr,operandnum,tsize);
+                   end;
+                  if actasmtoken=AS_LPAREN then
+                    BuildReference(instr);
                 end;
              end; { end if }
           end; { end if }
@@ -3710,16 +3682,18 @@ end;
 
 
 Begin
-  { you will get range problems here }
-  if lastop_in_table > last_instruction_in_cache then
-   Internalerror(2111);
   old_exit := exitproc;
   exitproc := @ra386att_exit;
 end.
 
 {
   $Log$
-  Revision 1.28  1998-12-28 15:47:09  peter
+  Revision 1.29  1999-01-10 15:37:54  peter
+    * moved some tables from ra386*.pas -> i386.pas
+    + start of coff writer
+    * renamed asmutils unit to rautils
+
+  Revision 1.28  1998/12/28 15:47:09  peter
     * general constant solution. Constant expressions are now almost
       everywhere allowed and correctly parsed
 

compiler/ra386dir.pas

@@ -33,7 +33,7 @@ unit Ra386dir;
 
      uses
         comphook,files,i386,hcodegen,globals,scanner,aasm,
-        cobjects,symtable,types,verbose,asmutils;
+        cobjects,symtable,types,verbose,rautils;
 
     function assemble : ptree;
 
@@ -288,7 +288,12 @@ unit Ra386dir;
 end.
 {
   $Log$
-  Revision 1.11  1998-11-17 00:26:12  peter
+  Revision 1.12  1999-01-10 15:37:57  peter
+    * moved some tables from ra386*.pas -> i386.pas
+    + start of coff writer
+    * renamed asmutils unit to rautils
+
+  Revision 1.11  1998/11/17 00:26:12  peter
     * fixed for $H+
 
   Revision 1.10  1998/11/13 15:40:28  pierre

compiler/ra386int.pas

@@ -79,8 +79,9 @@ var
 Implementation
 
 Uses
-  systems,files,aasm,globals,AsmUtils,strings,hcodegen,scanner,
-  cobjects,verbose,types;
+  strings,cobjects,systems,verbose,globals,
+  files,aasm,types,scanner,hcodegen,
+  rautils;
 
 
 type
@@ -106,11 +107,6 @@ const
    lastoperator   = AS_XOR;
    firstsreg      = R_CS;
    lastsreg       = R_SS;
-   { this is a hack to accept all opcodes }
-   { in the opcode table.                 }
-   { check is done until A_EMMS           }
-   { otherwise no check.                  }
-   lastop_in_table = A_EMMS;
 
        _count_asmdirectives = longint(lastdirective)-longint(firstdirective);
        _count_asmoperators  = longint(lastoperator)-longint(firstoperator);
@@ -151,31 +147,6 @@ const
        A_SCAS,A_SCAS,A_SCAS,A_STOS,A_STOS,A_STOS,A_MOVS,A_MOVS,A_MOVS,
        A_LODS,A_LODS,A_LODS,A_LOCK,A_NONE,A_NONE,A_NONE,A_NONE);
      {------------------------------------------------------------------}
-       { register type definition table for easier searching }
-       _regtypes:array[firstreg..lastreg] of longint =
-       (ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,ao_reg32,
-       ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,ao_reg16,
-       ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,ao_reg8,
-       ao_none,ao_sreg2,ao_sreg2,ao_sreg2,ao_sreg3,ao_sreg3,ao_sreg2,
-       ao_floatacc,ao_floatacc,ao_floatreg,ao_floatreg,ao_floatreg,ao_floatreg,
-       ao_floatreg,ao_floatreg,ao_floatreg);
-
-       _regsizes: array[firstreg..lastreg] of topsize =
-       (S_L,S_L,S_L,S_L,S_L,S_L,S_L,S_L,
-        S_W,S_W,S_W,S_W,S_W,S_W,S_W,S_W,
-        S_B,S_B,S_B,S_B,S_B,S_B,S_B,S_B,
-        { segment register }
-        S_W,S_W,S_W,S_W,S_W,S_W,S_W,
-        { can also be S_S or S_T - must be checked at run-time }
-        S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL);
-
-       {topsize = (S_NO,S_B,S_W,S_L,S_BW,S_BL,S_WL,
-                  S_IS,S_IL,S_IQ,S_FS,S_FL,S_FX,S_D);}
-       _constsizes: array[S_NO..S_FS] of longint =
-       (0,ao_imm8,ao_imm16,ao_imm32,0,0,0,ao_imm16,ao_imm32,0,ao_imm32);
-
-
-
 
 const
   newline = #10;
@@ -743,7 +714,7 @@ var
                        { check if there is not already a default size }
                        if opr.size <> S_NO then
                        Begin
-                          findtype := _constsizes[opr.size];
+                          findtype := const_2_type[opr.size];
                          exit;
                        end;
                        if val < $ff then
@@ -763,7 +734,7 @@ var
                        end
                      end;
        OPR_REGISTER: Begin
-                      findtype := _regtypes[reg];
+                      findtype := reg_2_type[reg];
                       exit;
                      end;
          OPR_SYMBOL: Begin
@@ -936,7 +907,7 @@ var
      Begin
        case instr.operands[i].operandtype of
          OPR_REGISTER: instr.operands[i].size :=
-                         _regsizes[instr.operands[i].reg];
+                         reg_2_size[instr.operands[i].reg];
        end; { end case }
      end; { endif }
     { setup specific instructions for first pass }
@@ -1324,14 +1295,15 @@ var
     { after reading the operands }
     { search the instruction     }
     { setup startvalue from cache }
-    if ins_cache[instruc]<>-1 then
-       i:=ins_cache[instruc]
-    else i:=0;
+    if itcache^[instruc]<>-1 then
+       i:=itcache^[instruc]
+    else
+       i:=0;
 
 
     { this makes cpu.pp uncompilable, but i think this code should be }
     { inserted in the system unit anyways.                            }
-    if (instruc > lastop_in_table) then
+    if (instruc > lastop_ittable) then
       begin
          Message1(assem_w_opcode_not_in_table,upper(int_op2str[instruc]));
          fits:=true;
@@ -1340,8 +1312,8 @@ var
       begin
        { set the instruction cache, if the instruction }
        { occurs the first time                         }
-       if (it[i].i=instruc) and (ins_cache[instruc]=-1) then
-           ins_cache[instruc]:=i;
+       if (it[i].i=instruc) and (itcache^[instruc]=-1) then
+           itcache^[instruc]:=i;
 
        if (it[i].i=instruc) and (instr.numops=it[i].ops) then
        begin
@@ -3497,14 +3469,16 @@ end;
 
 begin
    old_exit:=exitproc;
-   { you will get range problems here }
-   if lastop_in_table > last_instruction_in_cache then
-     Internalerror(2111);
    exitproc:=@ra386int_exit;
 end.
 {
   $Log$
-  Revision 1.19  1998-12-23 22:55:57  peter
+  Revision 1.20  1999-01-10 15:37:58  peter
+    * moved some tables from ra386*.pas -> i386.pas
+    + start of coff writer
+    * renamed asmutils unit to rautils
+
+  Revision 1.19  1998/12/23 22:55:57  peter
     + rec.field(%esi) support
     + [esi+rec.field] support
 

compiler/ra68kmot.pas

@@ -73,7 +73,7 @@ var
 Implementation
 
 uses
-  files,globals,systems,AsmUtils,strings,hcodegen,scanner,aasm,
+  files,globals,systems,RAUtils,strings,hcodegen,scanner,aasm,
   cobjects,verbose,symtable;
 
 
@@ -2178,7 +2178,12 @@ Begin
 end.
 {
   $Log$
-  Revision 1.7  1998-12-11 00:03:45  peter
+  Revision 1.8  1999-01-10 15:37:59  peter
+    * moved some tables from ra386*.pas -> i386.pas
+    + start of coff writer
+    * renamed asmutils unit to rautils
+
+  Revision 1.7  1998/12/11 00:03:45  peter
     + globtype,tokens,version unit splitted from globals
 
   Revision 1.6  1998/10/13 16:50:19  pierre

compiler/asmutils.pas → compiler/rautils.pas

@@ -3,6 +3,7 @@
     Copyright (c) 1998 Carl Eric Codere
 
     This unit implements some support routines for assembler parsing
+    independent of the processor
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -20,7 +21,7 @@
 
  **********************************************************************}
 
-Unit AsmUtils;
+Unit RAUtils;
 
 {*************************************************************************}
 {  This unit implements some objects as well as utilities which will be   }
@@ -1802,77 +1803,9 @@ end;
 end.
 {
   $Log$
-  Revision 1.17  1998-12-23 22:55:55  peter
-    + rec.field(%esi) support
-    + [esi+rec.field] support
-
-  Revision 1.16  1998/12/11 00:02:44  peter
-    + globtype,tokens,version unit splitted from globals
-
-  Revision 1.15  1998/11/17 00:26:11  peter
-    * fixed for $H+
-
-  Revision 1.14  1998/11/05 23:48:17  peter
-    * recordtype.field support in constant expressions
-    * fixed imul for oa_imm8 which was not allowed
-    * fixed reading of local typed constants
-    * fixed comment reading which is not any longer a separator
-
-  Revision 1.13  1998/10/28 00:08:45  peter
-    + leal procsym,eax is now allowed
-    + constants are now handled also when starting an expression
-    + call *pointer is now allowed
-
-  Revision 1.12  1998/10/14 11:28:13  florian
-    * emitpushreferenceaddress gets now the asmlist as parameter
-    * m68k version compiles with -duseansistrings
-
-  Revision 1.11  1998/10/13 16:49:59  pierre
-    * undid some changes of Peter that made the compiler wrong
-      for m68k (I had to reinsert some ifdefs)
-    * removed several memory leaks under m68k
-    * removed the meory leaks for assembler readers
-    * cross compiling shoud work again better
-      ( crosscompiling sysamiga works
-       but as68k still complain about some code !)
-
-  Revision 1.10  1998/10/13 13:10:10  peter
-    * new style for m68k/i386 infos and enums
-
-  Revision 1.9  1998/09/24 17:54:15  carl
-    * bugfixes from fix branch
-
-  Revision 1.8.2.1  1998/09/24 17:46:25  carl
-   * support for objects in asm statements
-
-  Revision 1.8  1998/08/27 00:43:06  carl
-    +} now record offsets searches set the operand sizes
-
-  Revision 1.7  1998/08/18 20:51:32  peter
-    * fixed bug 42
-
-  Revision 1.6  1998/08/10 14:49:40  peter
-    + localswitches, moduleswitches, globalswitches splitting
-
-  Revision 1.5  1998/07/14 21:46:38  peter
-    * updated messages file
-
-  Revision 1.4  1998/06/04 23:51:31  peter
-    * m68k compiles
-    + .def file creation moved to gendef.pas so it could also be used
-      for win32
-
-  Revision 1.3  1998/05/31 14:13:30  peter
-    * fixed call bugs with assembler readers
-    + OPR_SYMBOL to hold a symbol in the asm parser
-    * fixed staticsymtable vars which were acessed through %ebp instead of
-      name
-
-  Revision 1.2  1998/04/29 10:33:43  pierre
-    + added some code for ansistring (not complete nor working yet)
-    * corrected operator overloading
-    * corrected nasm output
-    + started inline procedures
-    + added starstarn : use ** for exponentiation (^ gave problems)
-    + started UseTokenInfo cond to get accurate positions
+  Revision 1.1  1999-01-10 15:38:00  peter
+    * moved some tables from ra386*.pas -> i386.pas
+    + start of coff writer
+    * renamed asmutils unit to rautils
+
 }

compiler/systems.pas

@@ -67,11 +67,12 @@ unit systems;
        tasm = (as_none
             ,as_i386_o,as_i386_o_aout,as_i386_asw,
             as_i386_nasmcoff,as_i386_nasmelf,as_i386_nasmobj,
-            as_i386_tasm,as_i386_masm
+            as_i386_tasm,as_i386_masm,
+            as_i386_coff
             ,as_m68k_o,as_m68k_gas,as_m68k_mit,as_m68k_mot,as_m68k_mpw
        );
      const
-       {$ifdef i386} i386asmcnt=8; {$else} i386asmcnt=0; {$endif}
+       {$ifdef i386} i386asmcnt=9; {$else} i386asmcnt=0; {$endif}
        {$ifdef m68k} m68kasmcnt=5; {$else} m68kasmcnt=0; {$endif}
        asmcnt=i386asmcnt+m68kasmcnt+1;
 
@@ -522,6 +523,15 @@ implementation
             labelprefix : '.L';
             comment : '; '
           )
+          ,(
+            id     : as_i386_coff;
+            idtxt  : 'COFF';
+            asmbin : 'as';
+            asmcmd : '-o $OBJ $ASM';
+            externals : false;
+            labelprefix : '.L';
+            comment : '# '
+          )
 {$endif i386}
 {$ifdef m68k}
           ,(
@@ -1314,7 +1324,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.55  1999-01-06 22:58:47  florian
+  Revision 1.56  1999-01-10 15:38:01  peter
+    * moved some tables from ra386*.pas -> i386.pas
+    + start of coff writer
+    * renamed asmutils unit to rautils
+
+  Revision 1.55  1999/01/06 22:58:47  florian
     + some stuff for the new code generator
 
   Revision 1.54  1998/12/28 23:26:26  peter