freepascal.compiler/compiler/m68k/agcpugas.pas

{
    $Id$
    Copyright (c) 1998-2002 by Florian Klaempfl

    This unit implements an asmoutput class for m68k GAS syntax

    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.

 ****************************************************************************
}
{ This unit implements an asmoutput class for i386 AT&T syntax
}
unit agcpugas;

{$i fpcdefs.inc}

interface

    uses
      cclasses,cpubase,
      globals,
      aasmbase,aasmtai,aasmcpu,assemble,aggas;

    type
      TM68kAssembler=class(TGNUassembler)
      public
        procedure WriteInstruction(hp: tai);override;
      end;

    const
      gas_op2str:op2strtable=
       { 68000 only instructions }
       ('abcd','add', 'adda','addi','addq','addx','and','andi',
       'asl','asr','bcc','bcs','beq','bge','bgt','bhi',
       'ble','bls','blt','bmi','bne','bpl','bvc','bvs',
       'bchg','bclr','bra','bset','bsr','btst','chk',
       'clr','cmp','cmpa','cmpi','cmpm','dbcc','dbcs','dbeq','dbge',
       'dbgt','dbhi','dble','dbls','dblt','dbmi','dbne','dbra',
       'dbpl','dbt','dbvc','dbvs','dbf','divs','divu',
       'eor','eori','exg','illegal','ext','jmp','jsr',
       'lea','link','lsl','lsr','move','movea','movei','moveq',
       'movem','movep','muls','mulu','nbcd','neg','negx',
       'nop','not','or','ori','pea','rol','ror','roxl',
       'roxr','rtr','rts','sbcd','scc','scs','seq','sge',
       'sgt','shi','sle','sls','slt','smi','sne',
       'spl','st','svc','svs','sf','sub','suba','subi','subq',
       'subx','swap','tas','trap','trapv','tst','unlk',
       'rte','reset','stop',
       { MC68010 instructions }
       'bkpt','movec','moves','rtd',
       { MC68020 instructions }
       'bfchg','bfclr','bfexts','bfextu','bfffo',
       'bfins','bfset','bftst','callm','cas','cas2',
       'chk2','cmp2','divsl','divul','extb','pack','rtm',
       'trapcc','tracs','trapeq','trapf','trapge','trapgt',
       'traphi','traple','trapls','traplt','trapmi','trapne',
       'trappl','trapt','trapvc','trapvs','unpk',
       { FPU Processor instructions - directly supported only. }
       { IEEE aware and misc. condition codes not supported   }
       'fabs','fadd',
       'fbeq','fbne','fbngt','fbgt','fbge','fbnge',
       'fblt','fbnlt','fble','fbgl','fbngl','fbgle','fbngle',
       'fdbeq','fdbne','fdbgt','fdbngt','fdbge','fdnbge',
       'fdblt','fdbnlt','fdble','fdbgl','fdbngl','fdbgle','fbdngle',
       'fseq','fsne','fsgt','fsngt','fsge','fsnge',
       'fslt','fsnlt','fsle','fsgl','fsngl','fsgle','fsngle',
       'fcmp','fdiv','fmove','fmovem',
       'fmul','fneg','fnop','fsqrt','fsub','fsgldiv',
       'fsflmul','ftst',
       'fint','fintrz',
       'ftrapeq','ftrapne','ftrapgt','ftrapngt','ftrapge','ftrapnge',
       'ftraplt','ftrapnlt','ftraple','ftrapgl','ftrapngl','ftrapgle',
       'ftrapngle',
       { Useful for assembly langage output }
       { Protected instructions }
       'cprestore','cpsave',
       { FPU Unit protected instructions                    }
       { and 68030/68851 common MMU instructions            }
       { (this may include 68040 MMU instructions)          }
       'frestore','fsave','pflush','pflusha','pload','pmove','ptest',
       { Useful for assembly langage output }
       '','','','');

     gas_opsize2str : array[topsize] of string[2] = 
     ('','.b','.w','.l','.s','.d','.x',''
     );
     
     gas_reg2str : reg2strtable =
      ('', '%d0','%d1','%d2','%d3','%d4','%d5','%d6','%d7',
       '%a0','%a1','%a2','%a3','%a4','%a5','%a6','%sp',
       '-(%sp)','(%sp)+',
       '%ccr','%fp0','%fp1','%fp2','%fp3','%fp4','%fp5',
       '%fp6','%fp7','%fpcr','%sr','%ssp','%dfc',
       '%sfc','%vbr','%fpsr');
     

  implementation

    uses
      cutils,systems,
      verbose;



    function getreferencestring(var ref : treference) : string;
      var
         s,basestr,indexstr : string;

      begin
         s:='';
         with ref do
           begin
             inc(offset,offsetfixup);
             offsetfixup:=0;
             basestr:=gas_reg2str[base];
             indexstr:=gas_reg2str[index];
             if assigned(symbol) then
               s:=s+symbol.name;

             if offset<0 then s:=s+tostr(offset)
              else if (offset>0) then
                begin
                  if (symbol=nil) then s:=tostr(offset)
                       else s:=s+'+'+tostr(offset);
                    end
                  else if (index=R_NO) and (base=R_NO) and not assigned(symbol) then
                    s:=s+'0';

               if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then
                begin
                  if (scalefactor = 1) or (scalefactor = 0) then
                    s:=s+'(,'+indexstr+'.l)'
                  else
                    s:=s+'(,'+indexstr+'.l*'+tostr(scalefactor)+')'
                end
                else if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then
                begin
                  if (scalefactor = 1) or (scalefactor = 0) then
                      s:=s+'('+basestr+')+'
                  else
                   InternalError(10002);
                end
                else if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then
                begin
                  if (scalefactor = 1) or (scalefactor = 0) then
                      s:=s+'-('+basestr+')'
                  else
                   InternalError(10003);
                end
                  else if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then
                begin
                  s:=s+'('+basestr+')'
                end
                  else if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then
                begin
                  if (scalefactor = 1) or (scalefactor = 0) then
                    s:=s+'('+basestr+','+indexstr+'.l)'
                  else
                    s:=s+'('+basestr+','+indexstr+'.l*'+tostr(scalefactor)+')';
                end;
          end;      
         getreferencestring:=s;
      end;
      

    function getopstr(const o:toper) : string;
    var
      hs : string;
      i : tregister;
    begin
      case o.typ of
            top_reg : getopstr:=gas_reg2str[o.reg];
            top_ref : getopstr:=getreferencestring(o.ref^);
        top_reglist : begin
                      hs:='';
                      for i:=R_NO to R_FPSR do
                      begin
                        if i in o.registerlist then
                         hs:=hs+gas_reg2str[i]+'/';
                      end;
                      delete(hs,length(hs),1);
                      getopstr := hs;
                    end;
             top_const : getopstr:='#'+tostr(o.val);
            top_symbol :
                    { compare with i386, where a symbol is considered }
                    { a constant.                                     }
                    begin
                     if assigned(o.sym) then
                       hs:='#'+o.sym.name
                     else
                       hs:='#';
                       if o.symofs>0 then
                        hs:=hs+'+'+tostr(o.symofs)
                       else
                        if o.symofs<0 then
                         hs:=hs+tostr(o.symofs)
                       else
                        if not(assigned(o.sym)) then
                          hs:=hs+'0';
                       getopstr:=hs;
                    end;
            else internalerror(10001);
         end;
      end;

    function getopstr_jmp(const o:toper) : string;
    var
      hs : string;
    begin
      case o.typ of
            top_reg : getopstr_jmp:=gas_reg2str[o.reg];
            top_ref : getopstr_jmp:=getreferencestring(o.ref^);
            top_const : getopstr_jmp:=tostr(o.val);
            top_symbol : begin
                           if assigned(o.sym) then
                             hs:=o.sym.name
                           else
                             hs:='';
                             if o.symofs>0 then
                              hs:=hs+'+'+tostr(o.symofs)
                             else
                              if o.symofs<0 then
                               hs:=hs+tostr(o.symofs)
                             else
                              if not(assigned(o.sym)) then
                                hs:=hs+'0';
                           getopstr_jmp:=hs;
                         end;
            else internalerror(10001);
         end;
      end;

{****************************************************************************
                            TM68kASMOUTPUT
 ****************************************************************************}

(*
   ait_instruction : begin
                       { old versions of GAS don't like PEA.L and LEA.L }
                       if (paicpu(hp)^.opcode in [
                            A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST,
                            A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS,
                            A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,
                            A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
                        s:=#9+mot_op2str[paicpu(hp)^.opcode]
                       else
                        s:=#9+mot_op2str[paicpu(hp)^.opcode]+mit_opsize2str[paicpu(hp)^.opsize];
                       if paicpu(hp)^.ops>0 then
                        begin
                        { call and jmp need an extra handling                          }
                        { this code is only callded if jmp isn't a labeled instruction }
                          if paicpu(hp)^.opcode in [A_BSR,A_BRA,A_LEA,A_PEA,A_JSR,A_JMP] then
                           s:=s+#9#9+getopstr_jmp(paicpu(hp)^.oper[0])
                          else
                            s:=s+#9+getopstr(paicpu(hp)^.oper[0]);
                           if paicpu(hp)^.ops>1 then
                            begin
                              s:=s+','+getopstr(paicpu(hp)^.oper[1]);
                            { three operands }
                              if paicpu(hp)^.ops>2 then
                               begin
                                   if (paicpu(hp)^.opcode = A_DIVSL) or
                                      (paicpu(hp)^.opcode = A_DIVUL) or
                                      (paicpu(hp)^.opcode = A_MULU) or
                                      (paicpu(hp)^.opcode = A_MULS) or
                                      (paicpu(hp)^.opcode = A_DIVS) or
                                      (paicpu(hp)^.opcode = A_DIVU) then
                                    s:=s+':'+getopstr(paicpu(hp)^.oper[2])
                                   else
                                    s:=s+','+getopstr(paicpu(hp)^.oper[2]);
                               end;
                            end;
                        end;
                       AsmWriteLn(s);
                     end;


ait_labeled_instruction : begin
                     { labeled operand }
                       if pai_labeled(hp)^.register = R_NO then
                         begin
                           if pai_labeled(hp)^.lab <> nil then
                             AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^.opcode]+#9+pai_labeled(hp)^.lab^.name)
                           else
                             AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^.opcode]+#9+pai_labeled(hp)^.sym^.name);
                         end
                       else
                     { labeled operand with register }
                        begin
                           if pai_labeled(hp)^.lab <> nil then
                             begin
                                  AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^.opcode]+#9+
                                    gas_reg2str[pai_labeled(hp)^.register]+','+pai_labeled(hp)^.lab^.name);
                               end
                           else
                           { a symbol is the value }
                             begin
                                  AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^.opcode]+#9+
                                    gas_reg2str[pai_labeled(hp)^.register]+','+pai_labeled(hp)^.sym^.name);
                             end;
                        end;
                     end;
*)

    { returns the opcode string }
    function getopcodestring(hp : tai) : string;
      var
        op : tasmop;
        s : string;
      begin
        op:=taicpu(hp).opcode;
        { old versions of GAS don't like PEA.L and LEA.L }
        if (op in [
         A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST,
         A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS,
         A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,
         A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
         s:=gas_op2str[op]
        else
        if op = A_SXX then
         s:=gas_op2str[op]+cond2str[taicpu(hp).condition]
        else
        if op in [a_dbxx,a_bxx,a_fbxx] then
         s:=gas_op2str[op]+cond2str[taicpu(hp).condition]+gas_opsize2str[taicpu(hp).opsize]
        else
         s:=gas_op2str[op]+gas_opsize2str[taicpu(hp).opsize];
        getopcodestring:=s; 
      end;

    procedure TM68kAssembler. WriteInstruction(hp: tai);
    var
      op       : tasmop;
      s        : string;
      sep      : char;
      calljmp  : boolean;
      i        : integer;
     begin
       if hp.typ <> ait_instruction then exit;
       op:=taicpu(hp).opcode;
       calljmp:=is_calljmp(op);
       { call maybe not translated to call }
       s:=#9+getopcodestring(hp);
       { process operands }
       if taicpu(hp).ops<>0 then
         begin
           { call and jmp need an extra handling                          }
           { this code is only called if jmp isn't a labeled instruction  }
           { quick hack to overcome a problem with manglednames=255 chars }
           if calljmp then
              begin
                AsmWrite(s+#9);
                s:=getopstr_jmp(taicpu(hp).oper[0]);
              end
            else
              begin
                for i:=0 to taicpu(hp).ops-1 do
                  begin
                    if i=0 then
                      sep:=#9
                    else
                    if ((op = A_DIVSL) or
                       (op = A_DIVUL) or
                       (op = A_MULU) or
                       (op = A_MULS) or
                       (op = A_DIVS) or
                       (op = A_DIVU)) and (i=1) then
                      sep:=':'
                    else
                      sep:=',';
                    s:=s+sep+getopstr(taicpu(hp).oper[i])
                  end;
              end;
         end;
         AsmWriteLn(s);
     end;


{*****************************************************************************
                                  Initialize
*****************************************************************************}

    const
       as_m68k_as_info : tasminfo =
          (
            id     : as_gas;
            idtxt  : 'AS';
            asmbin : 'as';
            asmcmd : '-o $OBJ $ASM';
            supported_target : system_any;
            outputbinary: false;
            allowdirect : true;
            needar : true;
            labelprefix_only_inside_procedure : false;
            labelprefix : '.L';
            comment : '# ';
            secnames : ('',
              '.text','.data','.bss',
              '','','','','','',
              '.stab','.stabstr','COMMON')
          );

initialization
  RegisterAssembler(as_m68k_as_info,TM68kAssembler);
end.
{
  $Log$
  Revision 1.1  2002-08-13 18:01:52  carl
    * rename swatoperands to swapoperands
    + m68k first compilable version (still needs a lot of testing):
        assembler generator, system information , inline
        assembler reader.

}