freepascal.compiler/compiler/m68k/cgcpu.pas

{
    $Id$
    Copyright (c) 1998-2002 by the FPC team

    This unit implements the code generator for the 680x0

    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.

 ****************************************************************************
}
unit cgcpu;

{$i fpcdefs.inc}

  interface

    uses
       cginfo,cgbase,cgobj,
       aasmbase,aasmtai,aasmcpu,
       cpubase,cpuinfo,cpupara,
       node,symconst;

    type
      tcg68k = class(tcg)
          procedure a_call_name(list : taasmoutput;const s : string);override;
          procedure a_call_ref(list : taasmoutput;const ref : treference);override;
          procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);override;
          procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);override;
          procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);override;
          procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);override;
          procedure a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister);override;
          procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
          procedure a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); override;
          procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
          procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
          procedure a_loadmm_reg_reg(list: taasmoutput; reg1, reg2: tregister); override;
          procedure a_loadmm_ref_reg(list: taasmoutput; const ref: treference; reg: tregister); override;
          procedure a_loadmm_reg_ref(list: taasmoutput; reg: tregister; const ref: treference); override;
          procedure a_parammm_reg(list: taasmoutput; reg: tregister); override;
          procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
          procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override;
          procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
            l : tasmlabel);override;
          procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
          procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
          procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
          procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); override;

          procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);override;
          { generates overflow checking code for a node }
          procedure g_overflowcheck(list: taasmoutput; const p: tnode); override;
          procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer); override;
          { 
            This routine should setup the stack frame and allocate @var(localsize) bytes on
            the local stack (for local variables). It should also setup the frame pointer,
            so that all variables are now accessed via the frame pointer register.
          }  
          procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
          { restores the previous frame pointer at procedure exit }
          procedure g_restore_frame_pointer(list : taasmoutput);override;
          { This routine should update the stack pointer so that parasize are freed
            from the stack. It should also emit the return instruction
          }  
          procedure g_return_from_proc(list : taasmoutput;parasize : aword);override;
          procedure g_save_standard_registers(list : taasmoutput);override;
          procedure g_restore_standard_registers(list : taasmoutput);override;
          procedure g_save_all_registers(list : taasmoutput);override;
          procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
     private
          { # Sign or zero extend the register to a full 32-bit value.
              The new value is left in the same register.
          }
          procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
          procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
     end;

Implementation

    uses
       globtype,globals,verbose,systems,cutils,
       symdef,symsym,defbase,paramgr,
       rgobj,tgobj,rgcpu;

const
      TCGSize2OpSize: Array[tcgsize] of topsize =
        (S_NO,S_B,S_W,S_L,S_L,S_B,S_W,S_L,S_L,
         S_FS,S_FD,S_FX,S_NO,
         S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
         
         
      { opcode table lookup }
      topcg2tasmop: Array[topcg] of tasmop =
      (
       A_NONE, 
       A_ADD,
       A_AND,
       A_DIVU,
       A_DIVS,
       A_MULS,
       A_MULU,
       A_NEG,
       A_NOT,
       A_OR,
       A_ASR,
       A_LSL,
       A_LSR,
       A_SUB,
       A_EOR
      );
       
        
      TOpCmp2AsmCond: Array[topcmp] of TAsmCond = 
      (
       C_NONE,
       C_EQ,
       C_GT,
       C_LT,
       C_GE,
       C_LE,
       C_NE,
       C_LS,
       C_CS,
       C_CC,
       C_HI
      );
       



    procedure tcg68k.a_call_name(list : taasmoutput;const s : string);

      begin
        list.concat(taicpu.op_sym(A_JSR,S_NO,objectlibrary.newasmsymbol(s)));
      end;


    procedure tcg68k.a_call_ref(list : taasmoutput;const ref : treference);

      begin
        list.concat(taicpu.op_ref(A_JSR,S_NO,ref));
      end;


    procedure tcg68k.a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);
      begin
        if (rg.isaddressregister(register)) then
         begin
           list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register))
         end
        else
        if a = 0 then
           list.concat(taicpu.op_reg(A_CLR,S_L,register))
        else
         begin
           if (longint(a) >= -128) and (longint(a) <= 127) then
              list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,a,register))
           else   
              list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register))
         end;
      end;
      
    procedure tcg68k.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);
      begin
         { move to destination reference }
         list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[size],register,ref));
      end;
      
    procedure tcg68k.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);
      begin
         { move to destination register }
         list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2));
         { zero/sign extend register to 32-bit }
         sign_extend(list, size, reg2);
      end;
      
    procedure tcg68k.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);
      begin
         list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[size],ref,register));
         { extend the value in the register }
         sign_extend(list, size, register);
      end;
      
    procedure tcg68k.a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister);
      begin
{$warning To complete this section}      
      end;
      
    procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
      begin
        if (not rg.isaddressregister(r)) then
          begin
            internalerror(2002072901);
          end;
        list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,r));
      end;
      
    procedure tcg68k.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); 
      begin
        list.concat(taicpu.op_reg_reg(A_FMOVE,S_FD,reg1,reg2));
      end;
      

    procedure tcg68k.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); 
     var
      opsize : topsize;
      begin
        opsize := tcgsize2opsize[size];   
        { extended is not supported, since it is not available on Coldfire }
        if opsize = S_FX then
          internalerror(20020729);
        list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,ref,reg));
      end;
      
    procedure tcg68k.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); 
      var
       opsize : topsize;
      begin
        opsize := tcgsize2opsize[size];   
        { extended is not supported, since it is not available on Coldfire }
        if opsize = S_FX then
          internalerror(20020729);
        list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref));
      end;
      
    procedure tcg68k.a_loadmm_reg_reg(list: taasmoutput; reg1, reg2: tregister); 
      begin
        internalerror(20020729);
      end;
      
    procedure tcg68k.a_loadmm_ref_reg(list: taasmoutput; const ref: treference; reg: tregister); 
      begin
        internalerror(20020729);
      end;
      
    procedure tcg68k.a_loadmm_reg_ref(list: taasmoutput; reg: tregister; const ref: treference); 
      begin
        internalerror(20020729);
      end;
      
    procedure tcg68k.a_parammm_reg(list: taasmoutput; reg: tregister); 
      begin
        internalerror(20020729);
      end;
      

    procedure tcg68k.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); 
      var
       scratch_reg : tregister;
       scratch_reg2: tregister;
       opcode : tasmop;
      begin
        opcode := topcg2tasmop[op];
        case op of
          OP_ADD : 
              Begin
                if (a >= 1) and (a <= 8) then
                    list.concat(taicpu.op_const_reg(A_ADDQ,S_L,a, reg))
                else  
                  begin
                    { all others, including coldfire }
                    list.concat(taicpu.op_const_reg(A_ADD,S_L,a, reg));
                  end;
              end;
          OP_AND,
          OP_OR:
              Begin  
                 list.concat(taicpu.op_const_reg(topcg2tasmop[op],S_L,a, reg));
              end;
          OP_DIV :
              Begin
{$warning To complete DIV opcode}              
              end;
          OP_IDIV :
              Begin
{$warning To complete IDIV opcode}              
              end;
          OP_IMUL :
              Begin
                 if aktoptprocessor = MC68000 then
                   begin
                     rg.getexplicitregisterint(list,R_D0);
                     rg.getexplicitregisterint(list,R_D1);
                     list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, R_D0));
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, R_D1));
                     cg.a_call_name(list,'FPC_MUL_LONGINT');
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,R_D0, reg));
                     rg.ungetregisterint(list,R_D0);
                     rg.ungetregisterint(list,R_D1);
                   end
                  else
                    begin
                      if (rg.isaddressregister(reg)) then
                       begin
                         scratch_reg := cg.get_scratch_reg_int(list);
                         list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
                         list.concat(taicpu.op_const_reg(A_MULS,S_L,a,scratch_reg));
                         list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
                         cg.free_scratch_reg(list,scratch_reg);
                       end
                      else
                         list.concat(taicpu.op_const_reg(A_MULS,S_L,a,reg));
                    end;
              end;
          OP_MUL :
              Begin
                 if aktoptprocessor = MC68000 then
                   begin
                     rg.getexplicitregisterint(list,R_D0);
                     rg.getexplicitregisterint(list,R_D1);
                     list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, R_D0));
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, R_D1));
                     cg.a_call_name(list,'FPC_MUL_CARDINAL');
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,R_D0, reg));
                     rg.ungetregisterint(list,R_D0);
                     rg.ungetregisterint(list,R_D1);
                   end
                  else
                    begin
                      if (rg.isaddressregister(reg)) then
                       begin
                         scratch_reg := cg.get_scratch_reg_int(list);
                         list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
                         list.concat(taicpu.op_const_reg(A_MULU,S_L,a,scratch_reg));
                         list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
                         cg.free_scratch_reg(list,scratch_reg);
                       end
                      else
                         list.concat(taicpu.op_const_reg(A_MULU,S_L,a,reg));
                    end;
              end;
          OP_SAR,    
          OP_SHL,
          OP_SHR :
              Begin
                if (a >= 1) and (a <= 8) then
                 begin 
                   { now allowed to shift an address register }
                   if (rg.isaddressregister(reg)) then
                     begin
                       scratch_reg := cg.get_scratch_reg_int(list);
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
                       list.concat(taicpu.op_const_reg(opcode,S_L,a, scratch_reg));
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
                       cg.free_scratch_reg(list,scratch_reg);
                     end
                   else
                     list.concat(taicpu.op_const_reg(opcode,S_L,a, reg));
                 end
                else
                 begin
                   { we must load the data into a register ... :() }
                   scratch_reg := cg.get_scratch_reg_int(list);
                   list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, scratch_reg));
                   { again... since shifting with address register is not allowed }
                   if (rg.isaddressregister(reg)) then
                     begin
                       scratch_reg2 := cg.get_scratch_reg_int(list);
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg2));
                       list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, scratch_reg2));
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg2,reg));
                       cg.free_scratch_reg(list,scratch_reg2);
                     end
                   else
                     list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, reg));
                   cg.free_scratch_reg(list,scratch_reg);  
                 end;
              end;
          OP_SUB :
              Begin
                if (a >= 1) and (a <= 8) then
                    list.concat(taicpu.op_const_reg(A_SUBQ,S_L,a,reg))
                else  
                  begin
                    { all others, including coldfire }
                    list.concat(taicpu.op_const_reg(A_SUB,S_L,a, reg));
                  end;
              end;
          OP_XOR :
              Begin
                 list.concat(taicpu.op_const_reg(A_EORI,S_L,a, reg));
              end;
        else
            internalerror(20020729);
         end;   
      end;
      
    procedure tcg68k.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); 
      var
       hreg1,hreg2: tregister;
      begin
        case op of
          OP_ADD : 
              Begin
                 if aktoptprocessor = ColdFire then
                  begin
                    { operation only allowed only a longword }
                    sign_extend(list, size, reg1);
                    sign_extend(list, size, reg2);
                    list.concat(taicpu.op_reg_reg(A_ADD,S_L,reg1, reg2));
                  end
                 else
                  begin
                    list.concat(taicpu.op_reg_reg(A_ADD,TCGSize2OpSize[size],reg1, reg2));
                  end;
              end;
          OP_AND,OP_OR,
          OP_SAR,OP_SHL,
          OP_SHR,OP_SUB,OP_XOR :
              Begin
                 { load to data registers }
                 if (rg.isaddressregister(reg1)) then
                   begin
                     hreg1 := cg.get_scratch_reg_int(list);
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
                   end  
                 else
                   hreg1 := reg1;
                   
                 if (rg.isaddressregister(reg2))  then
                   begin
                      hreg2:= cg.get_scratch_reg_int(list);
                      list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
                   end
                 else
                   hreg2 := reg2;
                 
                 if aktoptprocessor = ColdFire then
                  begin
                    { operation only allowed only a longword }
                    {!***************************************
                      in the case of shifts, the value to 
                      shift by, should already be valid, so
                      no need to sign extend the value
                     ! 
                    }
                    if op in [OP_AND,OP_OR,OP_SUB,OP_XOR] then
                       sign_extend(list, size, hreg1);
                    sign_extend(list, size, hreg2);
                    list.concat(taicpu.op_reg_reg(topcg2tasmop[op],S_L,hreg1, hreg2));
                  end
                 else
                  begin
                    list.concat(taicpu.op_reg_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg1, hreg2));
                  end;
                  
                 if reg1 <> hreg1 then
                    cg.free_scratch_reg(list,hreg1);
                 { move back result into destination register }   
                 if reg2 <> hreg2 then
                   begin
                      list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
                      cg.free_scratch_reg(list,hreg2);
                   end;
              end;
          OP_DIV :
              Begin
{$warning DIV to complete}              
              end;
          OP_IDIV :
              Begin
{$warning IDIV to complete}              
              end;
          OP_IMUL :
              Begin
                 sign_extend(list, size,reg1);
                 sign_extend(list, size,reg2);
                 if aktoptprocessor = MC68000 then
                   begin
                     rg.getexplicitregisterint(list,R_D0);
                     rg.getexplicitregisterint(list,R_D1);
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, R_D0));
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, R_D1));
                     cg.a_call_name(list,'FPC_MUL_LONGINT');
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,R_D0, reg2));
                     rg.ungetregisterint(list,R_D0);
                     rg.ungetregisterint(list,R_D1);
                   end
                  else
                    begin
                     if (rg.isaddressregister(reg1)) then
                       hreg1 := cg.get_scratch_reg_int(list)
                     else
                       hreg1 := reg1;
                     if (rg.isaddressregister(reg2))  then
                       hreg2:= cg.get_scratch_reg_int(list)
                     else
                       hreg2 := reg2;
                 
                     if reg1 <> hreg1 then
                          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
                     if reg2 <> hreg2 then
                          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
                    
                     list.concat(taicpu.op_reg_reg(A_MULS,S_L,reg1,reg2));
                         
                     if reg1 <> hreg1 then
                       cg.free_scratch_reg(list,hreg1);
                     { move back result into destination register }   
                     if reg2 <> hreg2 then
                       begin
                          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
                          cg.free_scratch_reg(list,hreg2);
                       end;
                    end;
              end;
          OP_MUL :
              Begin
                 sign_extend(list, size,reg1);
                 sign_extend(list, size,reg2);
                 if aktoptprocessor = MC68000 then
                   begin
                     rg.getexplicitregisterint(list,R_D0);
                     rg.getexplicitregisterint(list,R_D1);
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, R_D0));
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, R_D1));
                     cg.a_call_name(list,'FPC_MUL_CARDINAL');
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,R_D0, reg2));
                     rg.ungetregisterint(list,R_D0);
                     rg.ungetregisterint(list,R_D1);
                   end
                  else
                    begin
                     if (rg.isaddressregister(reg1)) then
                      begin
                       hreg1 := cg.get_scratch_reg_int(list);
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
                      end
                     else
                       hreg1 := reg1;
                       
                     if (rg.isaddressregister(reg2))  then
                      begin
                       hreg2:= cg.get_scratch_reg_int(list);
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
                      end
                     else
                       hreg2 := reg2;
                 
                    
                     list.concat(taicpu.op_reg_reg(A_MULU,S_L,reg1,reg2));
                         
                     if reg1 <> hreg1 then
                       cg.free_scratch_reg(list,hreg1);
                     { move back result into destination register }   
                     if reg2 <> hreg2 then
                       begin
                          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
                          cg.free_scratch_reg(list,hreg2);
                       end;
                    end;
              end;
          OP_NEG,
          OP_NOT :
              Begin
                if reg1 <> R_NO then
                  internalerror(200112291);
              
                if (rg.isaddressregister(reg2)) then
                  begin
                     hreg2 := cg.get_scratch_reg_int(list);
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
                   end
                  else
                    hreg2 := reg2;

                { coldfire only supports long version }
                if aktoptprocessor = ColdFire then
                  begin
                    sign_extend(list, size,hreg2);
                    list.concat(taicpu.op_reg(topcg2tasmop[op],S_L,hreg2));
                  end
                else
                  begin
                    list.concat(taicpu.op_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg2));
                  end;

                if reg2 <> hreg2 then
                  begin
                    list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
                    cg.free_scratch_reg(list,hreg2);
                  end;
                   
              end;
        else
            internalerror(20020729);
         end;   
      end;
      
      
      
    procedure tcg68k.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
            l : tasmlabel);
      var
       hregister : tregister;
      begin
       if a = 0 then
         begin
           list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg));
         end
       else
         begin
           if (aktoptprocessor = ColdFire) then
             begin
               {
                 only longword comparison is supported,
                 and only on data registers.
               }
               hregister := cg.get_scratch_reg_int(list);
               { always move to a data register }
               list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg,hregister));
               { sign/zero extend the register }
               sign_extend(list, size,hregister);
               list.concat(taicpu.op_const_reg(A_CMPI,S_L,a,hregister));
               cg.free_scratch_reg(list,hregister);  
             end
           else
             begin
               list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg));
             end;
         end;
         { emit the actual jump to the label }
         a_jmp_cond(list,cmp_op,l);
      end;
      
    procedure tcg68k.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); 
      begin
         list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2));
         { emit the actual jump to the label }
         a_jmp_cond(list,cmp_op,l);
      end;
      
    procedure tcg68k.a_jmp_always(list : taasmoutput;l: tasmlabel); 
      var
       ai: taicpu;
      begin
         ai := Taicpu.op_sym(A_JMP,S_NO,l);
         ai.is_jmp := true;
         list.concat(ai);
      end;
      
    procedure tcg68k.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); 
       var
         ai : taicpu;
       begin
         ai := Taicpu.op_sym(A_BXX,S_NO,l);
         ai.SetCondition(flags_to_cond(f));
         ai.is_jmp := true;
         list.concat(ai);
       end;
      
    procedure tcg68k.g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); 
       var
         ai : taicpu;
         hreg : tregister;
       begin
          { move to a Dx register? }
          if (rg.isaddressregister(reg)) then
            begin
              hreg := get_scratch_reg_int(list);
              a_load_const_reg(list,size,0,hreg);
              ai:=Taicpu.Op_reg(A_Sxx,S_B,hreg);
              ai.SetCondition(flags_to_cond(f));
              list.concat(ai);
              
              if (aktoptprocessor = ColdFire) then
                begin
                 { neg.b does not exist on the Coldfire 
                   so we need to sign extend the value 
                   before doing a neg.l
                 }
                 list.concat(taicpu.op_reg(A_EXTB,S_L,hreg));
                 list.concat(taicpu.op_reg(A_NEG,S_L,hreg));
                end
              else
                begin
                  list.concat(taicpu.op_reg(A_NEG,S_B,hreg));
                end;
             list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg));
             free_scratch_reg(list,hreg);
            end
          else  
          begin
            a_load_const_reg(list,size,0,reg);
            ai:=Taicpu.Op_reg(A_Sxx,S_B,reg);
            ai.SetCondition(flags_to_cond(f));
            list.concat(ai);
            
            if (aktoptprocessor = ColdFire) then
              begin
                 { neg.b does not exist on the Coldfire 
                   so we need to sign extend the value 
                   before doing a neg.l
                 }
                 list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
                 list.concat(taicpu.op_reg(A_NEG,S_L,reg));
              end
            else
              begin
               list.concat(taicpu.op_reg(A_NEG,S_B,reg));
              end;
          end;
       end;

      

    procedure tcg68k.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);
     var
         helpsize : longint;
         i : byte;
         reg8,reg32 : tregister;
         swap : boolean;
         hregister : tregister;
         iregister : tregister;
         jregister : tregister;
         hp1 : treference;
         hp2 : treference;
         hl : tasmlabel;
         hl2: tasmlabel;
         popaddress : boolean;
         srcref,dstref : treference;

      begin
         popaddress := false;
         
         { this should never occur }
         if len > 65535 then
           internalerror(0);
         hregister := get_scratch_reg_int(list);
         if delsource then
            reference_release(list,source);


         { from 12 bytes movs is being used }
         if (not loadref) and ((len<=8) or (not(cs_littlesize in aktglobalswitches) and (len<=12))) then
           begin
              srcref := source;
              dstref := dest;
              helpsize:=len div 4;
              { move a dword x times }
              for i:=1 to helpsize do
                begin
                   list.concat(taicpu.op_ref_reg(A_MOVE,S_L,srcref,hregister));
                   list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,dstref));
                   inc(srcref.offset,4);
                   inc(dstref.offset,4);
                   dec(len,4);
                end;
              { move a word }
              if len>1 then
                begin
                   list.concat(taicpu.op_ref_reg(A_MOVE,S_W,srcref,hregister));
                   list.concat(taicpu.op_reg_ref(A_MOVE,S_W,hregister,dstref));
                   inc(srcref.offset,2);
                   inc(dstref.offset,2);
                   dec(len,2);
                end;
              { move a single byte }
              if len>0 then
                begin
                   list.concat(taicpu.op_ref_reg(A_MOVE,S_B,srcref,hregister));
                   list.concat(taicpu.op_reg_ref(A_MOVE,S_B,hregister,dstref));
                end

           end
         else
           begin
              iregister := get_scratch_reg_address(list);
              jregister := get_scratch_reg_address(list);
              { reference for move (An)+,(An)+ }
              reference_reset(hp1);
              hp1.base := iregister;   { source register }
              hp1.direction := dir_inc;
              reference_reset(hp2);
              hp2.base := jregister;
              hp2.direction := dir_inc;
              { iregister = source }
              { jregister = destination }

              if loadref then
                 list.concat(taicpu.op_ref_reg(A_MOVE,S_L,source,iregister))
              else
                 list.concat(taicpu.op_ref_reg(A_LEA,S_L,source,iregister));

              list.concat(taicpu.op_ref_reg(A_LEA,S_L,dest,jregister));

              { double word move only on 68020+ machines }
              { because of possible alignment problems   }
              { use fast loop mode }
              if (aktoptprocessor=MC68020) then
                begin
                   helpsize := len - len mod 4;
                   len := len mod 4;
                   list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize div 4,hregister));
                   objectlibrary.getlabel(hl2);
                   a_jmp_always(list,hl2);
                   objectlibrary.getlabel(hl);
                   a_label(list,hl);
                   list.concat(taicpu.op_ref_ref(A_MOVE,S_L,hp1,hp2));
                   cg.a_label(list,hl2);
                   list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
                   if len > 1 then
                     begin
                        dec(len,2);
                        list.concat(taicpu.op_ref_ref(A_MOVE,S_W,hp1,hp2));
                     end;
                   if len = 1 then
                     list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2));
                end
              else
                begin
                   { Fast 68010 loop mode with no possible alignment problems }
                   helpsize := len;
                   list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize,hregister));
                   objectlibrary.getlabel(hl2);
                   a_jmp_always(list,hl2);
                   objectlibrary.getlabel(hl);
                   a_label(list,hl);
                   list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2));
                   a_label(list,hl2);
                   list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
                end;

       { restore the registers that we have just used olny if they are used! }
              if jregister = R_A1 then
                hp2.base := R_NO;
              if iregister = R_A0 then
                hp1.base := R_NO;
              reference_release(list,hp1);
              reference_release(list,hp2);
           end;

           { loading SELF-reference again }
           g_maybe_loadself(list);

           if delsource then
               tg.ungetiftemp(list,source);

           free_scratch_reg(list,hregister);
    end;
      
    procedure tcg68k.g_overflowcheck(list: taasmoutput; const p: tnode); 
      begin
      end;
      
    procedure tcg68k.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer); 
      begin
      end;
      
    procedure tcg68k.g_stackframe_entry(list : taasmoutput;localsize : longint);
      begin
        if localsize<>0 then
           begin
             { Not to complicate the code generator too much, and since some  }
             { of the systems only support this format, the localsize cannot }
             { exceed 32K in size.                                            }
             if (localsize < -32767) or (localsize > 32768) then
                CGMessage(cg_e_stacklimit_in_local_routine);
             list.concat(taicpu.op_reg_const(A_LINK,S_W,frame_pointer_reg,-localsize));
           end { endif localsize <> 0 }
          else
           begin
             list.concat(taicpu.op_reg_reg(A_MOVE,S_L,frame_pointer_reg,R_SPPUSH));
             list.concat(taicpu.op_reg_reg(A_MOVE,S_L,stack_pointer_reg,frame_pointer_reg));
           end;
      end;
      
    procedure tcg68k.g_restore_frame_pointer(list : taasmoutput);
      begin
        list.concat(taicpu.op_reg(A_UNLK,S_NO,frame_pointer_reg));
      end;
      
    procedure tcg68k.g_return_from_proc(list : taasmoutput;parasize : aword);
      var
       hregister : tregister;
      begin
       {Routines with the poclearstack flag set use only a ret.}
       { also routines with parasize=0     }
         if (po_clearstack in aktprocdef.procoptions) then
           begin
             { complex return values are removed from stack in C code PM }
             if paramanager.ret_in_param(aktprocdef.rettype.def) then
               list.concat(taicpu.op_const(A_RTD,S_NO,4))
             else
               list.concat(taicpu.op_none(A_RTS,S_NO));
           end
         else if (parasize=0) then
           begin
             list.concat(taicpu.op_none(A_RTS,S_NO));
           end
         else
           begin
            { return with immediate size possible here }
            { signed!                                  }
            { RTD is not supported on the coldfire     }
            if (aktoptprocessor = MC68020) and (parasize < $7FFF) then
                list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
            { manually restore the stack }
            else
              begin
                { We must pull the PC Counter from the stack, before  }
                { restoring the stack pointer, otherwise the PC would }
                { point to nowhere!                                   }

                { save the PC counter (pop it from the stack)         }
                hregister := get_scratch_reg_address(list);
                list.concat(taicpu.op_reg_reg(A_MOVE,S_L,R_SPPULL,hregister));
                { can we do a quick addition ... }
                if (parasize > 0) and (parasize < 9) then
                   list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,R_SP))
                else { nope ... }
                   list.concat(taicpu.op_const_reg(A_ADD,S_L,parasize,R_SP));
                    
                { restore the PC counter (push it on the stack)       }
                list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hregister,R_SPPUSH));
                list.concat(taicpu.op_none(A_RTS,S_NO));
                free_scratch_reg(list,hregister);
               end;
           end;
      
      end;
      
    procedure tcg68k.g_save_standard_registers(list : taasmoutput);
      begin
      end;
      
    procedure tcg68k.g_restore_standard_registers(list : taasmoutput);
      begin
      end;
      
    procedure tcg68k.g_save_all_registers(list : taasmoutput);
      begin
      end;
      
    procedure tcg68k.g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);
      begin
      end;
      
    procedure tcg68k.sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
      begin
        case _oldsize of
         { sign extend }
         OS_S8:
              begin
                if (rg.isaddressregister(reg)) then
                   internalerror(20020729);
                if (aktoptprocessor = MC68000) then
                  begin
                    list.concat(taicpu.op_reg(A_EXT,S_W,reg));
                    list.concat(taicpu.op_reg(A_EXT,S_L,reg));
                  end
                else
                  begin
                    list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
                  end;
              end;
         OS_S16:
              begin
                if (rg.isaddressregister(reg)) then
                   internalerror(20020729);
                list.concat(taicpu.op_reg(A_EXT,S_L,reg));
              end;
         { zero extend }
         OS_8:
              begin
                if (rg.isaddressregister(reg)) then
                   internalerror(20020729);
                list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
              end;
         OS_16:
              begin
                if (rg.isaddressregister(reg)) then
                   internalerror(20020729);
                list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
              end;
        end; { otherwise the size is already correct }
      end;

     procedure tcg68k.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);

       var
         ai : taicpu;

       begin
         if cond=OC_None then
           ai := Taicpu.Op_sym(A_JMP,S_NO,l)
         else
           begin
             ai:=Taicpu.Op_sym(A_Bxx,S_NO,l);
             ai.SetCondition(TOpCmp2AsmCond[cond]);
           end;
         ai.is_jmp:=true;
         list.concat(ai);
       end;


begin
  cg := tcg68k.create;
{  cg64 :=tcg64fppc.create;}
end.

{ 
  $Log$
  Revision 1.1  2002-08-13 18:30:22  carl
    * rename swatoperands to swapoperands
    + m68k first compilable version (still needs a lot of testing):
        assembler generator, system information , inline
        assembler reader.

  Revision 1.5  2002/08/12 15:08:43  carl
    + stab register indexes for powerpc (moved from gdb to cpubase)
    + tprocessor enumeration moved to cpuinfo
    + linker in target_info is now a class
    * many many updates for m68k (will soon start to compile)
    - removed some ifdef or correct them for correct cpu

  Revision 1.2  2002/08/05 17:27:52  carl
    + updated m68k

  Revision 1.1  2002/07/29 17:51:32  carl
    + restart m68k support

}