* first implementation of concatcopy (requires 4 scratch regs)

compiler/new/powerpc/cgcpu.pas

@@ -1,382 +1,446 @@
-{
-    $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)
-          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 a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;
-              const ref: treference; l : pasmlabel);
-          procedure a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;l : longint;reg : tregister;
-            l : pasmlabel);}
-
-          procedure a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);virtual;
-          procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
-          procedure g_restore_frame_pointer(list : paasmoutput);virtual;
-
-
-          private
-
-          procedure a_op_reg_reg_const32(list: PAasmOutPut; OpLo, OpHi: TAsmOp;
-                                          reg1, reg2: TRegister; a: AWord);
-          procedure fixref(var ref: treference);
-       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 TAsmCond = (C_EQ,C_GT,C_LT,C_GE,
-                           C_LE,C_NE,C_LE,C_NG,C_GE,C_NL);
-
-
-  implementation
-
-    uses
-       globtype,globals,verbose;
-
-    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);
-           Case size of
-             OS_8 : op := A_STB;
-             OS_16: op := A_STH;
-             OS_32: op := A_STW;
-             Else InternalError(68993)
-           End;
-           list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(ref))));
-         End;
-
-     procedure tcgppc.a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref2: treference;reg : tregister);
-
-     Var
-       op: TAsmOp;
-       ref: TReference;
-
-       begin
-         ref := ref2;
-         FixRef(ref);
-         Case size of
-           OS_8 : op := A_LBZ;
-           OS_16: op := A_LHZ;
-           OS_32: op := A_LWZ
-           Else InternalError(68994)
-         End;
-         list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(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 $ffff) <> 0 Then
-                 list^.concat(new(paicpu,op_reg_reg_const(
-                   TOpCG2AsmOpLo[Op],reg,reg,a and $ffff)));
-               If (a shr 16) <> 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 AsmCond: TAsmCond;
-          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;
-           AsmCond := TOpCmp2AsmCond[cmp_op];
-           list^.concat(new(paicpu,op_const_const_sym(A_BC,AsmCond2BO[AsmCond],
-             AsmCond2BI[AsmCond],newasmsymbol(l^.name))));
-        end;
-
-
-      procedure tcgppc.a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;
-        reg1,reg2 : tregister;l : pasmlabel);
-
-      var AsmCond: TAsmCond;
-
-      begin
-        list^.concat(new(paicpu,op_const_reg_reg(A_CMPL,0,reg1,reg2)));
-        AsmCond := TOpCmp2AsmCond[cmp_op];
-        list^.concat(new(paicpu,op_const_const_sym(A_BC,AsmCond2BO[AsmCond],
-          AsmCond2BI[AsmCond],newasmsymbol(l^.name))));
-      end;
-{
-      procedure tcgpp.a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;
-        const ref: treference; l : pasmlabel);
-
-      var scratch_register: TRegister;
-
-      begin
-        scratch_register := get_scratch_reg(list);
-        a_load_ref_reg(list,ref,scratch_register);
-        a_cmp_reg_reg_label(list,size,cmp_op,reg,scratch_register,l)
-        free_scratch_reg(list,scratch_register);
-     end;
-
-      procedure tcgpp.a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;l : longint;reg : tregister;
-        l : pasmlabel);
-
-      var sr: TRegister;
-
-        begin
-          sr := get_scratch_register(list);
-
-          a_cmp
-}
-
-     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;
-
-{ *********** 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 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;
-
-
-{***************** This is private property, keep out! :) *****************}
-
-    procedure tcgppc.fixref(var ref: treference);
-
- { Make sure ref is a valid reference for the PowerPC and sets the base to  }
- { the value of the index if (base = R_NO). (Index <> R_NO) is not checked  }
- { because the less conditional jumps, the better                           }
-
-       begin
-         If (ref.base <> R_NO) and (ref.index <> R_NO) and
-            (ref.offset <> 0) Then Internalerror(58992);
-         if (ref.base = R_NO) Then
-           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);
- { Generates                                                                }
- {   OpLo reg1, reg2, (a and $ffff) and/or                                  }
- {   OpHi reg1, reg2, (a shr 16)                                            }
- { depending on the value of a                                              }
-
-     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;
-
-end.
-{
+{
+    $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)
+          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 tcgppc.g_return_from_proc(list : paasmoutput;parasize : aword);
+
+          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
+
+          procedure a_op_reg_reg_const32(list: PAasmOutPut; OpLo, OpHi: TAsmOp;
+                                          reg1, reg2: TRegister; a: AWord);
+          procedure fixref(var ref: treference);
+       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 TAsmCond = (C_EQ,C_GT,C_LT,C_GE,
+                           C_LE,C_NE,C_LE,C_NG,C_GE,C_NL);
+
+
+  implementation
+
+    uses
+       globtype,globals,verbose;
+
+    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);
+           Case size of
+             OS_8 : op := A_STB;
+             OS_16: op := A_STH;
+             OS_32: op := A_STW;
+             Else InternalError(68993)
+           End;
+           list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(ref))));
+         End;
+
+     procedure tcgppc.a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref2: treference;reg : tregister);
+
+     Var
+       op: TAsmOp;
+       ref: TReference;
+
+       begin
+         ref := ref2;
+         FixRef(ref);
+         Case size of
+           OS_8 : op := A_LBZ;
+           OS_16: op := A_LHZ;
+           OS_32: op := A_LWZ
+           Else InternalError(68994)
+         End;
+         list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(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 $ffff)));
+               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 AsmCond: TAsmCond;
+          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;
+           AsmCond := TOpCmp2AsmCond[cmp_op];
+           list^.concat(new(paicpu,op_const_const_sym(A_BC,AsmCond2BO[AsmCond],
+             AsmCond2BI[AsmCond],newasmsymbol(l^.name))));
+        end;
+
+
+      procedure tcgppc.a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;
+        reg1,reg2 : tregister;l : pasmlabel);
+
+      var AsmCond: TAsmCond;
+
+      begin
+        list^.concat(new(paicpu,op_const_reg_reg(A_CMPL,0,reg1,reg2)));
+        AsmCond := TOpCmp2AsmCond[cmp_op];
+        list^.concat(new(paicpu,op_const_const_sym(A_BC,AsmCond2BO[AsmCond],
+          AsmCond2BI[AsmCond],newasmsymbol(l^.name))));
+      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 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);virtual;
+
+    var
+      countreg, tempreg: TRegister;
+      src, dst: TReference;
+      lab: PAsmLabel;
+      count, count2: aword;
+
+      begin
+        { make sure source and dest are valid }
+        src := fixreference(source);
+        dst := fixreference(dest);
+        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_load_address_ref_reg(list,source,src.base);
+        { load the address of dest into dst.base }
+        dst.base := get_scratch_reg(list);
+        a_load_address_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);
+            list^.concat(new(paicpu,op_const_const_sym(A_BC,AsmCond2BO[C_NE],
+              AsmCond2BI[C_NE],newasmsymbol(l^.name))));
+            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);
+
+ { Make sure ref is a valid reference for the PowerPC and sets the base to  }
+ { the value of the index if (base = R_NO). (Index <> R_NO) is not checked  }
+ { because the less conditional jumps, the better                           }
+
+       begin
+         If (ref.base <> R_NO) and (ref.index <> R_NO) and
+            (ref.offset <> 0) Then Internalerror(58992);
+         if (ref.base = R_NO) Then
+           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);
+ { Generates                                                                }
+ {   OpLo reg1, reg2, (a and $ffff) and/or                                  }
+ {   OpHi reg1, reg2, (a shr 16)                                            }
+ { depending on the value of a                                              }
+
+     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;
+
+end.
+{
   $Log$
-  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
-
-
-}
+  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
+
+
+}