freepascal.compiler/compiler/new/powerpc/cgcpu.pas

{
    $Id$
    Copyright (c) 1993-98 by Florian Klaempfl

    This unit implements the code generator for the PowerPC

    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;

  interface

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

    type
       pcgppc = ^tcgppc;

       tcgppc = object(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 : paasmoutput;size : tcgsize;r : tregister;nr : longint);virtual;
          procedure a_param_const(list : paasmoutput;size : tcgsize;a : aword;nr : longint);virtual;
          procedure a_param_ref(list : paasmoutput;size : tcgsize;const r : treference;nr : longint);virtual;
          procedure a_paramaddr_ref(list : paasmoutput;const r : treference;nr : longint);virtual;


          procedure a_call_name(list : paasmoutput;const s : string;
            offset : longint);virtual;

          procedure a_op_reg_const(list : paasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; a: AWord); virtual;

          { move instructions }
          procedure a_load_const_reg(list : paasmoutput; size: tcgsize; a : aword;reg : tregister);virtual;
          procedure a_load_reg_ref(list : paasmoutput; size: tcgsize; reg : tregister;const ref2 : treference);virtual;
          procedure a_load_ref_reg(list : paasmoutput;size : tcgsize;const Ref2 : treference;reg : tregister);virtual;
          procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;

          {  comparison operations }
          procedure a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
            l : pasmlabel);virtual;
          procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);


          procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
          procedure g_restore_frame_pointer(list : paasmoutput);virtual;
          procedure g_return_from_proc(list : paasmoutput;parasize : aword); virtual;

          procedure a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);virtual;

          procedure g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);virtual;


          private

          { Generates                                                                }
          {   OpLo reg1, reg2, (a and $ffff) and/or }
          {   OpHi reg1, reg2, (a shr 16)           }
          { depending on the value of a             }
          procedure a_op_reg_reg_const32(list: paasmOutPut; oplo, ophi: tasmop;
                                          reg1, reg2: tregister; a: aword);
          { Make sure ref is a valid reference for the PowerPC and sets the }
          { base to the value of the index if (base = R_NO).                }
          procedure fixref(var ref: treference);

          { contains the common code of a_load_reg_ref and a_load_ref_reg }
          procedure a_load_store(list:paasmoutput;op: tasmop;reg:tregister;
                      var ref: treference);

          { creates the correct branch instruction for a given combination }
          { of asmcondflags and destination addressing mode                }
          procedure a_jmp(list: paasmoutput; op: tasmop;
                          c: tasmcondflags; l: pasmlabel);

       end;

const
  TOpCG2AsmOpLo: Array[topcg] of TAsmOp = (A_ADDI,A_ANDI_,A_DIVWU,
                      A_DIVW,A_MULLW, A_MULLW, A_NONE,A_NONE,A_ORI,
                      A_SRAWI,A_SLWI,A_SRWI,A_SUBI,A_XORI);
  TOpCG2AsmOpHi: Array[topcg] of TAsmOp = (A_ADDIS,A_ANDIS_,
                      A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE,
                      A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS);

  TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlags = (CF_EQ,CF_GT,CF_LT,CF_GE,
                       CF_LE,CF_NE,CF_LE,CF_NG,CF_GE,CF_NL);

  LoadInstr: Array[OS_8..OS_32,boolean, boolean] of TAsmOp =
                         { indexed? updating?}
             (((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)),
              ((A_LHZ,A_LHZU),(A_LHZX,A_LHZUX)),
              ((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)));

  StoreInstr: Array[OS_8..OS_32,boolean, boolean] of TAsmOp =
                          { indexed? updating?}
             (((A_STB,A_STBU),(A_STBX,A_STBUX)),
              ((A_STH,A_STHU),(A_STHX,A_STHUX)),
              ((A_STW,A_STWU),(A_STWX,A_STWUX)));


  implementation

    uses
       globtype,globals,verbose;

{ parameter passing... Still needs extra support from the processor }
{ independent code generator                                        }

    procedure tcgppc.a_param_reg(list : paasmoutput;size : tcgsize;r : tregister;nr : longint);

    var ref: treference;

    begin
{$ifdef para_sizes_known}
      if (nr <= max_param_regs_int) then
        a_load_reg_reg(list,size,r,param_regs_int[nr])
      else
        begin
          reset_reference(ref);
          ref.base := stack_pointer;
          ref.offset := LinkageAreaSize+para_size_till_now;
          a_load_reg_ref(list,size,reg,ref);
        end;
{$endif para_sizes_known}
    end;


    procedure tcgppc.a_param_const(list : paasmoutput;size : tcgsize;a : aword;nr : longint);

    var ref: treference;

    begin
{$ifdef para_sizes_known}
      if (nr <= max_param_regs_int) then
        a_load_const_reg(list,size,a,param_regs_int[nr])
      else
        begin
          reset_reference(ref);
          ref.base := stack_pointer;
          ref.offset := LinkageAreaSize+para_size_till_now;
          a_load_const_ref(list,size,a,ref);
        end;
{$endif para_sizes_known}
    end;


    procedure tcgppc.a_param_ref(list : paasmoutput;size : tcgsize;const r : treference;nr : longint);

    var ref: treference;
        tmpreg: tregister;

    begin
{$ifdef para_sizes_known}
      if (nr <= max_param_regs_int) then
        a_load_ref_reg(list,size,r,param_regs_int[nr])
      else
        begin
          reset_reference(ref);
          ref.base := stack_pointer;
          ref.offset := LinkageAreaSize+para_size_till_now;
          tmpreg := get_scratch_reg(list);
          a_load_ref_reg(list,size,r,tmpreg);
          a_load_reg_ref(list,size,tmpreg,ref);
          free_scratch_reg(list,tmpreg);
        end;
{$endif para_sizes_known}
    end;


    procedure tcgppc.a_paramaddr_ref(list : paasmoutput;const r : treference;nr : longint);

    var ref: treference;
        tmpreg: tregister;

    begin
{$ifdef para_sizes_known}
      if (nr <= max_param_regs_int) then
        a_loadaddress_ref_reg(list,size,r,param_regs_int[nr])
      else
        begin
          reset_reference(ref);
          ref.base := stack_pointer;
          ref.offset := LinkageAreaSize+para_size_till_now;
          tmpreg := get_scratch_reg(list);
          a_loadaddress_ref_reg(list,size,r,tmpreg);
          a_load_reg_ref(list,size,tmpreg,ref);
          free_scratch_reg(list,tmpreg);
        end;
{$endif para_sizes_known}
    end;

{ calling a code fragment by name }

    procedure tcgppc.a_call_name(list : paasmoutput;const s : string;
      offset : longint);

      begin
 { save our RTOC register value. Only necessary when doing pointer based    }
 { calls or cross TOC calls, but currently done always                      }
         list^.concat(new(paicpu,op_reg_ref(A_STW,R_RTOC,
           new_reference(stack_pointer,LA_RTOC))));
         list^.concat(new(paicpu,op_sym(A_BL,newasmsymbol(s))));
         list^.concat(new(paicpu,op_reg_ref(A_LWZ,R_RTOC,
           new_reference(stack_pointer,LA_RTOC))));
      end;

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

     procedure tcgppc.a_load_const_reg(list : paasmoutput; size: TCGSize; a : aword; reg : TRegister);

       begin
          If (a and $ffff) <> 0 Then
            Begin
              list^.concat(new(paicpu,op_reg_const(A_LI,reg,a and $ffff)));
              If (a shr 16) <> 0 Then
                list^.concat(new(paicpu,op_reg_const(A_ORIS,reg,a shr 16)))
            End
          Else
            list^.concat(new(paicpu,op_reg_const(A_LIS,reg,a shr 16)));
       end;

     procedure tcgppc.a_load_reg_ref(list : paasmoutput; size: TCGSize; reg : tregister;const ref2 : treference);

     Var
       op: TAsmOp;
       ref: TReference;

       begin
         ref := ref2;
         FixRef(ref);
         op := storeinstr[size,ref.index<>R_NO,false];
         a_load_store(list,op,reg,ref);
       End;

     procedure tcgppc.a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref2: treference;reg : tregister);

     Var
       op: TAsmOp;
       tmpreg: tregister;
       ref, tmpref: TReference;

       begin
         ref := ref2;
         FixRef(ref);
         op := loadinstr[size,ref.index<>R_NO,false];
         a_load_store(list,op,reg,ref);
       end;

     procedure tcgppc.a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);

       begin
         list^.concat(new(paicpu,op_reg_reg(A_MR,reg2,reg1)));
       end;

     procedure tcgppc.a_op_reg_const(list : paasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; a: AWord);

     var scratch_register: TRegister;

       begin
         Case Op of
           OP_DIV, OP_IDIV, OP_IMUL, OP_MUL:
             If (Op = OP_IMUL) And (longint(a) >= -32768) And
                (longint(a) <= 32767) Then
               list^.concat(new(paicpu,op_reg_reg_const(A_MULLI,reg,reg,a)))
             Else
               Begin
                 scratch_register := get_scratch_reg(list);
                 a_load_const_reg(list, OS_32, a, scratch_register);
                 list^.concat(new(paicpu,op_reg_reg_reg(TOpCG2AsmOpLo[Op],
                   reg,reg,scratch_register)));
                 free_scratch_reg(list,scratch_register);
               End;
           OP_ADD, OP_AND, OP_OR, OP_SUB,OP_XOR:
             a_op_reg_reg_const32(list,TOpCG2AsmOpLo[Op],
               TOpCG2AsmOpHi[Op],reg,reg,a);
           OP_SHL,OP_SHR,OP_SAR:
             Begin
               if (a and 31) <> 0 Then
                 list^.concat(new(paicpu,op_reg_reg_const(
                   TOpCG2AsmOpLo[Op],reg,reg,a and 31)));
               If (a shr 5) <> 0 Then
                 InternalError(68991);
             End
           Else InternalError(68992);
         end;
       end;


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

      procedure tcgppc.a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
        l : pasmlabel);

      var p: paicpu;
          scratch_register: TRegister;
          signed: boolean;

        begin
          signed := cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE];
          If signed Then
            If (longint(a) >= -32768) and (longint(a) <= 32767) Then
              list^.concat(new(paicpu,op_const_reg_const(A_CMPI,0,reg,a)))
            else
              begin
                scratch_register := get_scratch_reg(list);
                a_load_const_reg(list,OS_32,a,scratch_register);
                list^.concat(new(paicpu,op_const_reg_reg(A_CMP,0,reg,scratch_register)));
                free_scratch_reg(list,scratch_register);
             end
           else
             if (a <= $ffff) then
              list^.concat(new(paicpu,op_const_reg_const(A_CMPLI,0,reg,a)))
            else
              begin
                scratch_register := get_scratch_reg(list);
                a_load_const_reg(list,OS_32,a,scratch_register);
                list^.concat(new(paicpu,op_const_reg_reg(A_CMPL,0,reg,scratch_register)));
                free_scratch_reg(list,scratch_register);
             end;
           a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l);
        end;


      procedure tcgppc.a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;
        reg1,reg2 : tregister;l : pasmlabel);

      var p: paicpu;
          AsmCond: TAsmCondFlags;

      begin
        list^.concat(new(paicpu,op_const_reg_reg(A_CMPL,0,reg1,reg2)));
        a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l);
      end;


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

    procedure tcgppc.g_stackframe_entry(list : paasmoutput;localsize : longint);
 { generated the entry code of a procedure/function. Note: localsize is the }
 { sum of the size necessary for local variables and the maximum possible   }
 { combined size of ALL the parameters of a procedure called by the current }
 { one                                                                      }
     var scratch_register: TRegister;

      begin
        if (localsize mod 8) <> 0 then internalerror(58991);
 { CR and LR only have to be saved in case they are modified by the current }
 { procedure, but currently this isn't checked, so save them always         }
        scratch_register := get_scratch_reg(list);
        list^.concat(new(paicpu,op_reg(A_MFCR,scratch_register)));
        list^.concat(new(paicpu,op_reg_ref(A_STW,scratch_register,
          new_reference(stack_pointer,LA_CR))));
        free_scratch_reg(list,scratch_register);
        scratch_register := get_scratch_reg(list);
        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,scratch_register,
          R_LR)));
        list^.concat(new(paicpu,op_reg_ref(A_STW,scratch_register,
          new_reference(stack_pointer,LA_LR))));
        free_scratch_reg(list,scratch_register);
{ if the current procedure is a leaf procedure, we can use the Red Zone,    }
{ but this is not yet implemented                                           }
{        if ((procinfo.flags and pi_do_call) <> 0) And                      }
{           (localsize <= (256 - LinkageAreaSize)) Then                     }
           Begin
             if localsize<>0 then
               begin
 { allocate space for the local variable, parameter and linkage area and   }
 { save the stack pointer at the end of the linkage area                   }
                 if localsize <= $ffff Then
                   list^.concat(new(paicpu,op_reg_ref
                     (A_STWU,stack_pointer, new_reference(stack_pointer,localsize+
                      LinkageAreaSize))))
                 else
                   Begin
                     scratch_register := get_scratch_reg(list);
                     a_load_const_reg(list,OS_32,localsize,scratch_register);
                     list^.concat(new(paicpu,op_reg_reg_reg(A_STWUX,stack_pointer,
                       stack_pointer,scratch_register)));
                     free_scratch_reg(list,scratch_register);
                  End;
               End
           End;
       end;

    procedure tcgppc.g_restore_frame_pointer(list : paasmoutput);

      begin
 { no frame pointer on the PowerPC                                          }
      end;

     procedure tcgppc.g_return_from_proc(list : paasmoutput;parasize : aword);

     begin
       abstract;
     end;

     procedure tcgppc.a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);

     Var
       ref: TReference;

       begin
         ref := ref2;
         FixRef(ref);
         If ref.offset <> 0 Then
           If ref.base <> R_NO then
             a_op_reg_reg_const32(list,A_ADDI,A_ADDIS,r,r,ref.offset)
  { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
  { occurs, so now only ref.offset has to be loaded                         }
           else a_load_const_reg(list, OS_32, ref.offset, r)
         else
           if ref.index <> R_NO Then
             list^.concat(new(paicpu,op_reg_reg_reg(A_ADD,r,ref.base,ref.index)))
           else list^.concat(new(paicpu,op_reg_reg(A_MR,r,ref.base)))
       end;

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

    procedure tcgppc.g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);

    var
      p: paicpu;
      countreg, tempreg: TRegister;
      src, dst: TReference;
      lab: PAsmLabel;
      count, count2: aword;
      begin
        { make sure source and dest are valid }
        src := source;
        fixref(src);
        dst := dest;
        fixref(dst);
        reset_reference(src);
        reset_reference(dst);
        { load the address of source into src.base }
        src.base := get_scratch_reg(list);
        if loadref then
          a_load_ref_reg(list,OS_32,source,src.base)
        else a_loadaddress_ref_reg(list,source,src.base);
        { load the address of dest into dst.base }
        dst.base := get_scratch_reg(list);
        a_loadaddress_ref_reg(list,dest,dst.base);
        count := len div 4;
        if count > 3 then
          { generate a loop }
          begin
            Inc(dst.offset,4);
            Inc(src.offset,4);
            a_op_reg_reg_const32(list,A_SUBI,A_NONE,src.base,src.base,4);
            a_op_reg_reg_const32(list,A_SUBI,A_NONE,dst.base,dst.base,4);
            countreg := get_scratch_reg(list);
            a_load_const_reg(list,OS_32,count-1,countreg);
            tempreg := get_scratch_reg(list);
            getlabel(lab);
            a_label(list, lab);
            list^.concat(new(paicpu,op_reg_ref(A_LWZU,tempreg,
              newreference(src))));
            a_op_reg_reg_const32(list,A_CMPI,A_NONE,R_CR0,countreg,0);
            list^.concat(new(paicpu,op_reg_ref(A_STWU,tempreg,
              newreference(dst))));
            a_op_reg_reg_const32(list,A_SUBI,A_NONE,countreg,countreg,1);
            a_jmp(list,A_BC,CF_NE,lab);
            free_scratch_reg(list,countreg);
          end
        else
          { unrolled loop }
          begin
            tempreg := get_scratch_reg(list);
            for count2 := 1 to count do
              begin
                a_load_ref_reg(list,OS_32,src,tempreg);
                a_load_reg_ref(list,OS_32,tempreg,dst);
                inc(src.offset,4);
                inc(dst.offset,4);
              end
          end;
       { copy the leftovers }
       if (len and 2) <> 0 then
         begin
           a_load_ref_reg(list,OS_16,src,tempreg);
           a_load_reg_ref(list,OS_16,tempreg,dst);
           inc(src.offset,2);
           inc(dst.offset,2);
         end;
       if (len and 1) <> 0 then
         begin
           a_load_ref_reg(list,OS_8,src,tempreg);
           a_load_reg_ref(list,OS_8,tempreg,dst);
         end;
       free_scratch_reg(list,tempreg);
       free_scratch_reg(list,src.base);
       free_scratch_reg(list,dst.base);
      end;

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

    procedure tcgppc.fixref(var ref: treference);

       begin
         If (ref.base <> R_NO) then
           begin
             if (ref.index <> R_NO) and
                ((ref.offset <> 0) or assigned(ref.symbol)) Then
               Internalerror(58992)
           end
         else
           begin
             ref.base := ref.index;
             ref.index := R_NO
           end
       end;

    procedure tcgppc.a_op_reg_reg_const32(list: paasmoutput; oplo, ophi:
                       tasmop; reg1, reg2: tregister; a: aword);

      begin
        if (a and $ffff) <> 0 Then
          list^.concat(new(paicpu,op_reg_reg_const(OpLo,reg1,reg2,a and $ffff)));
        If (a shr 16) <> 0 Then
          list^.concat(new(paicpu,op_reg_reg_const(OpHi,reg1,reg2,a shr 16)))
      end;

    procedure tcgppc.a_load_store(list:paasmoutput;op: tasmop;reg:tregister;
                       var ref: treference);

    var tmpreg: tregister;
        tmpref: treference;

      begin
        if assigned(ref.symbol) then
          begin
            tmpreg := get_scratch_reg(list);
            reset_reference(tmpref);
            tmpref.symbol := ref.symbol;
            tmpref.symaddr := refs_ha;
            tmpref.is_immediate := true;
            if ref.base <> R_NO then
              list^.concat(new(paicpu,op_reg_reg_ref(A_ADDIS,tmpreg,
                ref.base,newreference(tmpref))))
            else
              list^.concat(new(paicpu,op_reg_ref(A_LIS,tmpreg,
                 newreference(tmpref))));
            ref.base := tmpreg
          end;
        list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(ref))));
        if assigned(ref.symbol) then
          free_scratch_reg(list,tmpreg);
      end;

    procedure tcgppc.a_jmp(list: paasmoutput; op: tasmop; c: tasmcondflags;
                l: pasmlabel);
    var p: paicpu;
    begin
      p := new(paicpu,op_sym(op,newasmsymbol(l^.name)));
      p^.condition := create_cond_norm(c,0);
      list^.concat(p)
    end;
end.
{
  $Log$
  Revision 1.5  1999-09-03 13:14:11  jonas
    + implemented some parameter passing methods, but they require\n    some more helper routines\n  * fix for loading symbol addresses (still needs to be done in a_loadaddress)\n  * several changes to the way conditional branches are handled

  Revision 1.4  1999/08/26 14:53:41  jonas
    * first implementation of concatcopy (requires 4 scratch regs)

  Revision 1.3  1999/08/25 12:00:23  jonas
    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)

  Revision 1.2  1999/08/18 17:05:57  florian
    + implemented initilizing of data for the new code generator
      so it should compile now simple programs

  Revision 1.1  1999/08/06 16:41:11  jonas
    * PowerPC compiles again, several routines implemented in cgcpu.pas
    * added constant to cpubase of alpha and powerpc for maximum
      number of operands


}