freepascal.compiler/compiler/i386/cgcpu.pas

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

    This unit implements the code generator for the i386

    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 defines.inc}

  interface

    uses
       cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo;

    type
      tcg386 = class(tcg)

        { passing parameters, per default the parameter is pushed }
        { nr gives the number of the parameter (enumerated from   }
        { left to right), this allows to move the parameter to    }
        { register, if the cpu supports register calling          }
        { conventions                                             }
        procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);override;
        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);override;
        procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);override;
        procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);override;


        procedure a_call_name(list : taasmoutput;const s : string;
          offset : longint);override;


        procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
        procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); override;
        procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
        procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override;
        procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); override;

        { move instructions }
        procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
        procedure a_load_const_ref(list : taasmoutput; size: tcgsize; a : aword;const ref : treference);override;
        procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref : treference);override;
        procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;reg : tregister);override;
        procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);override;
        procedure a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister); override;

        {  comparison operations }
        procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
          l : tasmlabel);override;
        procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
          l : tasmlabel);override;
        procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
        procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister; l : tasmlabel); override;

        procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); override;
        procedure g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister); override;


        procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
        procedure g_restore_frame_pointer(list : taasmoutput);override;
        procedure g_push_exception_value_reg(list : taasmoutput;reg : tregister);override;
        procedure g_push_exception_value_const(list : taasmoutput;reg : tregister);override;
        procedure g_pop_exception_value_reg(list : taasmoutput;reg : tregister);override;
        procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;

        procedure a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;

        procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;

        function makeregsize(var reg: tregister; size: tcgsize): topsize; override;

       private

        procedure sizes2load(s1: tcgsize; s2: topsize; var op: tasmop; var s3: topsize);


      end;

    const

      TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_ADD,A_AND,A_DIV,
                            A_IDIV,A_MUL, A_IMUL, A_NEG,A_NOT,A_OR,
                            A_SAR,A_SHL,A_SHR,A_SUB,A_XOR);

      TOpCmp2AsmCond: Array[topcmp] of TAsmCond = (C_NONE,C_E,C_G,
                           C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A);

      TCGSize2OpSize: Array[tcgsize] of topsize = (S_NO,S_B,S_W,S_L,S_L,
                                                        S_B,S_W,S_L,S_L);


  implementation

    uses
       globtype,globals,verbose,systems,cutils,cga;


    { we implement the following routines because otherwise we can't }
    { instantiate the class since it's abstract                      }

    procedure tcg386.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);

      begin
        runerror(211);
      end;


    procedure tcg386.a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);

      begin
        runerror(211);
      end;


    procedure tcg386.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);

      var
        tmpreg: tregister;

      begin
        case size of
          OS_8,OS_S8,OS_16,OS_S16:
            begin
              tmpreg := get_scratch_reg(list);
              a_load_ref_reg(list,size,r,tmpreg);
              if target_info.alignment.paraalign = 2 then
                list.concat(taicpu.op_reg(A_PUSH,S_W,makereg16(tmpreg)))
              else
                list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
            end;
          OS_32,OS_S32:
            list.concat(taicpu.op_ref(A_PUSH,S_L,newreference(r)));
          else
            internalerror(200109301);
        end;
      end;


    procedure tcg386.a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);

      begin
        runerror(211);
      end;

    procedure tcg386.a_call_name(list : taasmoutput;const s : string;
      offset : longint);

      begin
        list.concat(taicpu.op_sym_ofs(A_CALL,S_NO,newasmsymbol(s),offset));
      end;



{********************** load instructions ********************}

    procedure tcg386.a_load_const_reg(list : taasmoutput; size: TCGSize; a : aword; reg : TRegister);

      begin
        { the optimizer will change it to "xor reg,reg" when loading zero, }
        { no need to do it here too (JM)                                   }
        list.concat(taicpu.op_const_reg(A_MOV,TCGSize2OpSize[size],
          longint(a),reg))
      end;


    procedure tcg386.a_load_const_ref(list : taasmoutput; size: tcgsize; a : aword;const ref : treference);

      begin
        { zero is often used several times in succession -> load it in a  }
        { register and then store it to memory, so the optimizer can then }
        { remove the unnecessary loads of registers and you get smaller   }
        { (and faster) code                                               }
        if (a = 0) and
           (size in [OS_32,OS_S32]) then
          inherited a_load_const_ref(list,size,a,ref)
        else
          list.concat(taicpu.op_const_ref(A_MOV,TCGSize2OpSize[size],
            longint(a),newreference(ref)));
      end;


    procedure tcg386.a_load_reg_ref(list : taasmoutput; size: TCGSize; reg : tregister;const ref : treference);

      begin
        list.concat(taicpu.op_reg_ref(A_MOV,TCGSize2OpSize[size],reg,
          newreference(ref)));
      End;


    procedure tcg386.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref: treference;reg : tregister);

      var
        op: tasmop;
        s: topsize;

      begin
        if ref.is_immediate then
          a_load_const_reg(list,size,ref.offset,reg)
        else
          begin
            sizes2load(size,regsize(reg),op,s);
            list.concat(taicpu.op_ref_reg(op,s,newreference(ref),reg));
          end;
      end;


    procedure tcg386.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);

      var
        op: tasmop;
        s: topsize;

      begin
        sizes2load(size,regsize(reg2),op,s);
        if (makereg32(reg1) = makereg32(reg2)) then
          { "mov reg1, reg1" doesn't make sense }
          if op = A_MOV then
            exit
          else if (op = A_MOVZX) then
            case size of
              OS_8:
                begin
                  list.concat(taicpu.op_const_reg(A_AND,regsize(reg2),255,reg2));
                  exit;
                end;
              OS_16:
                begin
                  list.concat(taicpu.op_const_reg(A_AND,S_L,65535,reg1));
                  exit;
                end;
            end;
        list.concat(taicpu.op_reg_reg(op,s,reg1,reg2));
      end;


    procedure tcg386.a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister);

      begin
        list.concat(taicpu.op_sym_ofs_reg(A_MOV,S_L,sym,ofs,reg));
      end;

    procedure tcg386.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);

      var
        opcode: tasmop;
        power: longint;
        scratch_register: TRegister;

      begin
        Case Op of
          OP_DIV, OP_IDIV:
            Begin
              if ispowerof2(longint(a),power) then
                begin
                  case op of
                    OP_DIV:
                      opcode := A_SHR;
                    OP_IDIV:
                      opcode := A_SAR;
                  end;
                  list.concat(taicpu.op_const_reg(opcode,regsize(reg),power,
                    reg));
                  exit;
                end;
              { the rest should be handled specifically in the code      }
              { generator because of the silly register usage restraints }
              internalerror(200109224);
            End;
          OP_MUL,OP_IMUL:
            begin
              if not(cs_check_overflow in aktlocalswitches) and
                 ispowerof2(longint(a),power) then
                begin
                  list.concat(taicpu.op_const_reg(A_SHL,regsize(reg),power,
                    reg));
                  exit;
                end;
              if op = OP_IMUL then
                list.concat(taicpu.op_const_reg(A_IMUL,regsize(reg),
                  longint(a),reg))
              else
                { OP_MUL should be handled specifically in the code        }
                { generator because of the silly register usage restraints }
                internalerror(200109225);
            end;
          OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR:
            if (a = 1) and
               (op in [OP_ADD,OP_SUB]) then
              if op = OP_ADD then
                list.concat(taicpu.op_reg(A_INC,regsize(reg),reg))
              else
                list.concat(taicpu.op_reg(A_DEC,regsize(reg),reg))
            else
              list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],regsize(reg),
                longint(a),reg));
          OP_SHL,OP_SHR,OP_SAR:
            begin
              if (a and 31) <> 0 Then
                list.concat(taicpu.op_const_reg(
                  TOpCG2AsmOp[op],regsize(reg),a and 31,reg));
              if (a shr 5) <> 0 Then
                internalerror(68991);
            end
          else internalerror(68992);
        end;
      end;


     procedure tcg386.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference);

      var
        opcode: tasmop;
        power: longint;
        scratch_register: TRegister;

      begin
        Case Op of
          OP_DIV, OP_IDIV:
            Begin
              if ispowerof2(longint(a),power) then
                begin
                  case op of
                    OP_DIV:
                      opcode := A_SHR;
                    OP_IDIV:
                      opcode := A_SAR;
                  end;
                  list.concat(taicpu.op_const_ref(opcode,
                    TCgSize2OpSize[size],power,newreference(ref)));
                  exit;
                end;
              { the rest should be handled specifically in the code      }
              { generator because of the silly register usage restraints }
              internalerror(200109231);
            End;
          OP_MUL,OP_IMUL:
            begin
              if not(cs_check_overflow in aktlocalswitches) and
                 ispowerof2(longint(a),power) then
                begin
                  list.concat(taicpu.op_const_ref(A_SHL,TCgSize2OpSize[size],
                    power,newreference(ref)));
                  exit;
                end;
              { can't multiply a memory location directly with a constant }
              if op = OP_IMUL then
                inherited a_op_const_ref(list,op,size,a,ref)
              else
                { OP_MUL should be handled specifically in the code        }
                { generator because of the silly register usage restraints }
                internalerror(200109232);
            end;
          OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR:
            if (a = 1) and
               (op in [OP_ADD,OP_SUB]) then
              if op = OP_ADD then
                list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],
                  newreference(ref)))
              else
                list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],
                  newreference(ref)))
            else
              list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op],
                TCgSize2OpSize[size],longint(a),newreference(ref)));
          OP_SHL,OP_SHR,OP_SAR:
            begin
              if (a and 31) <> 0 Then
                list.concat(taicpu.op_const_ref(
                  TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,newreference(ref)));
              if (a shr 5) <> 0 Then
                internalerror(68991);
            end
          else internalerror(68992);
        end;
      end;


     procedure tcg386.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);

        var
          dstsize: topsize;

        begin
          dstsize := makeregsize(dst,size);
          case op of
            OP_NEG,OP_NOT:
              begin
                list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst));
              end;
            OP_MUL,OP_DIV,OP_IDIV:
              { special stuff, needs separate handling inside code }
              { generator                                          }
              internalerror(200109233);
            else
              begin
                if regsize(src) <> dstsize then
                  internalerror(200109226);
                list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,
                  src,dst));
              end;
          end;
        end;


     procedure tcg386.a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);

       var
         opsize: topsize;

       begin
          if ref.is_immediate then
            a_op_const_reg(list,op,ref.offset,reg)
          else
            begin
              case op of
                OP_NEG,OP_NOT,OP_IMUL:
                  begin
                    inherited a_op_ref_reg(list,op,size,ref,reg);
                  end;
                OP_MUL,OP_DIV,OP_IDIV:
                  { special stuff, needs separate handling inside code }
                  { generator                                          }
                  internalerror(200109239);
                else
                  begin
                    opsize := makeregsize(reg,size);
                    list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],opsize,
                      newreference(ref),reg));
                  end;
              end;
            end;
        end;


     procedure tcg386.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference);

       var
         opsize: topsize;

       begin
         case op of
           OP_NEG,OP_NOT:
             begin
               if reg <> R_NO then
                 internalerror(200109237);
               list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],
                 newreference(ref)));
             end;
           OP_IMUL:
             begin
               { this one needs a load/imul/store, which is the default }
               inherited a_op_ref_reg(list,op,size,ref,reg);
             end;
           OP_MUL,OP_DIV,OP_IDIV:
             { special stuff, needs separate handling inside code }
             { generator                                          }
             internalerror(200109238);
           else
             begin
               opsize := tcgsize2opsize[size];
               list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],opsize,reg,
                 newreference(ref)));
             end;
         end;
       end;

{*************** compare instructructions ****************}

      procedure tcg386.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
        l : tasmlabel);

        begin
          if a <> 0 then
            list.concat(taicpu.op_const_reg(A_CMP,regsize(reg),longint(a),
              reg))
          else
            list.concat(taicpu.op_reg_reg(A_TEST,regsize(reg),reg,reg));
          a_jmp_cond(list,cmp_op,l);
        end;

      procedure tcg386.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
        l : tasmlabel);

        begin
          list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size],
            longint(a),newreference(ref)));
          a_jmp_cond(list,cmp_op,l);
        end;

      procedure tcg386.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;
        reg1,reg2 : tregister;l : tasmlabel);

        begin
          if regsize(reg1) <> regsize(reg2) then
            internalerror(200109226);
          list.concat(taicpu.op_reg_reg(A_CMP,regsize(reg1),reg1,reg2));
          a_jmp_cond(list,cmp_op,l);
        end;

     procedure tcg386.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister;l : tasmlabel);

        var
          opsize: topsize;

        begin
          opsize := makeregsize(reg,size);
          list.concat(taicpu.op_ref_reg(A_CMP,opsize,newreference(ref),reg));
          a_jmp_cond(list,cmp_op,l);
        end;

     procedure tcg386.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_Jcc,S_NO,l);
             ai.SetCondition(TOpCmp2AsmCond[cond]);
           end;
         ai.is_jmp:=true;
         list.concat(ai);
       end;


     procedure tcg386.g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister);

       var
         ai : taicpu;
         hreg : tregister;
       begin
          hreg := makereg8(reg);
          ai:=Taicpu.Op_reg(A_Setcc,S_B,hreg);
          ai.SetCondition(flag_2_cond[f]);
          list.concat(ai);
          if hreg<>reg then
           begin
             if reg in regset16bit then
              emit_to_reg16(hreg)
             else
              emit_to_reg32(hreg);
           end;
       end;


{ *********** entry/exit code and address loading ************ }

    procedure tcg386.g_stackframe_entry(list : taasmoutput;localsize : longint);

      begin
        runerror(211);
      end;


    procedure tcg386.g_restore_frame_pointer(list : taasmoutput);

      begin
        runerror(211);
      end;


    procedure tcg386.g_push_exception_value_reg(list : taasmoutput;reg : tregister);

      begin
        runerror(211);
      end;


    procedure tcg386.g_push_exception_value_const(list : taasmoutput;reg : tregister);

      begin
        runerror(211);
      end;


    procedure tcg386.g_pop_exception_value_reg(list : taasmoutput;reg : tregister);

      begin
        runerror(211);
      end;


    procedure tcg386.g_return_from_proc(list : taasmoutput;parasize : aword);

      begin
        runerror(211);
      end;

     procedure tcg386.a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister);

       begin
         list.concat(taicpu.op_ref_reg(A_LEA,S_L,newreference(ref),r));
       end;

    function tcg386.makeregsize(var reg: tregister; size: tcgsize): topsize;

      begin
        { this function only allows downsizing a register, because otherwise }
        { we may start working with garbage (JM)                             }
        case size of
          OS_32,OS_S32:
            begin
              if not (reg in [R_EAX..R_EDI]) then
                internalerror(2001092313);
              result := S_L;
            end;
          OS_8,OS_S8:
            begin
              reg := makereg8(reg);
              result := S_B;
            end;
          OS_16,OS_S16:
            begin
              if reg in [R_AL..R_BH] then
                internalerror(2001092314);
              reg := makereg16(reg);
              result := S_W;
            end;
          else
            internalerror(2001092312);
        end;
      end;



{ ************* concatcopy ************ }

    procedure tcg386.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);

      { temp implementation, until it's permanenty moved here from cga.pas }

      var
        oldlist: taasmoutput;

      begin
        if list <> exprasmlist then
          begin
            oldlist := exprasmlist;
            exprasmlist := list;
          end;
        cga.concatcopy(source,dest,len,delsource,loadref);
        if list <> exprasmlist then
          list := oldlist;
      end;


{***************** This is private property, keep out! :) *****************}

    procedure tcg386.sizes2load(s1: tcgsize; s2: topsize; var op: tasmop; var s3: topsize);

       begin
         case s2 of
           S_B:
             if S1 in [OS_8,OS_S8] then
               s3 := S_B
             else internalerror(200109221);
           S_W:
             case s1 of
               OS_8,OS_S8:
                 s3 := S_BW;
               OS_16,OS_S16:
                 s3 := S_W;
               else internalerror(200109222);
             end;
           S_L:
             case s1 of
               OS_8,OS_S8:
                 s3 := S_BL;
               OS_16,OS_S16:
                 s3 := S_WL;
               OS_32,OS_S32:
                 s3 := S_L;
               else internalerror(200109223);
             end;
           else internalerror(200109227);
         end;
         if s3 in [S_B,S_W,S_L] then
           op := A_MOV
         else if s1 in [OS_8,OS_16,OS_32] then
           op := A_MOVZX
         else
           op := A_MOVSX;
       end;


begin
  cg := tcg386.create;
end.
{
  $Log$
  Revision 1.3  2001-09-30 16:17:18  jonas
    * made most constant and mem handling processor independent

  Revision 1.2  2001/09/29 21:32:19  jonas
    * fixed bug in a_load_reg_reg + implemented a_call

  Revision 1.1  2001/09/28 20:39:33  jonas
    * changed all flow control structures (except for exception handling
      related things) to processor independent code (in new ncgflw unit)
    + generic cgobj unit which contains lots of code generator helpers with
      global "cg" class instance variable
    + cgcpu unit for i386 (implements processor specific routines of the above
      unit)
    * updated cgbase and cpubase for the new code generator units
    * include ncgflw unit in cpunode unit

}