Selaa lähdekoodia

* some cg reorganisation
* some PPC updates

florian 24 vuotta sitten
vanhempi
commit
525be77ced

+ 7 - 3
compiler/new/powerpc/aoptcpu.pas

@@ -39,8 +39,12 @@ Implementation
 End.
 {
  $Log$
- Revision 1.1  2000-07-13 06:30:12  michael
- + Initial import
+ Revision 1.2  2001-08-26 13:29:33  florian
+   * some cg reorganisation
+   * some PPC updates
+
+ Revision 1.1  2000/07/13 06:30:12  michael
+   + Initial import
 
  Revision 1.2  2000/01/07 01:14:57  peter
    * updated copyright to 2000
@@ -48,4 +52,4 @@ End.
  Revision 1.1  1999/12/24 22:49:23  jonas
    + dummy to allow compiling
 
-}
+}

+ 43 - 0
compiler/new/powerpc/cga.pas

@@ -0,0 +1,43 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    Helper routines for the i386 code generator
+
+    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 cga;
+
+{$i defines.inc}
+
+interface
+
+    uses
+       cpubase,cpuasm,
+       symconst,symtype,symdef,aasm;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:29:33  florian
+    * some cg reorganisation
+    * some PPC updates
+
+}

+ 6 - 4
compiler/new/powerpc/cgcpu.pas

@@ -745,8 +745,12 @@ const
 end.
 {
   $Log$
-  Revision 1.1  2000-07-13 06:30:12  michael
-  + Initial import
+  Revision 1.2  2001-08-26 13:29:33  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:12  michael
+    + Initial import
 
   Revision 1.12  2000/04/22 14:25:04  jonas
     * aasm.pas: pai_align instead of pai_align_abstract if cpu <> i386
@@ -800,6 +804,4 @@ end.
     * PowerPC compiles again, several routines implemented in cgcpu.pas
     * added constant to cpubase of alpha and powerpc for maximum
       number of operands
-
-
 }

+ 145 - 53
compiler/new/powerpc/cpuasm.pas

@@ -1,6 +1,6 @@
 {
     $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
+    Copyright (c) 1999-2001 by Jonas Maebe
 
     Contains the assembler object for the PowerPC
 
@@ -25,15 +25,13 @@ unit cpuasm;
 interface
 
 uses
-  cobjects,
-  aasm,globals,verbose,
-  cpubase, tainst;
+  cclasses,
+  aasm,globals,verbose,tainst,
+  cpubase;
 
 type
 
-  paicpu = ^taicpu;
-  taicpu = object(tainstruction)
-
+  taicpu = class(tainstruction)
      constructor op_none(op : tasmop);
 
      constructor op_reg(op : tasmop;_op1 : tregister);
@@ -48,7 +46,7 @@ type
 
      constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
      constructor op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: Longint);
-     constructor op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: pasmsymbol;_op3ofs: longint);
+     constructor op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint);
      constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; _op3: preference);
      constructor op_const_reg_reg(op : tasmop;_op1 : longint;_op2, _op3 : tregister);
      constructor op_const_reg_const(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : longint);
@@ -61,19 +59,23 @@ type
 
 
      { this is for Jmp instructions }
-     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : pasmsymbol);
-     constructor op_const_const_sym(op : tasmop;_op1,_op2 : longint;_op3: pasmsymbol);
+     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
+     constructor op_const_const_sym(op : tasmop;_op1,_op2 : longint;_op3: tasmsymbol);
 
 
-     constructor op_sym(op : tasmop;_op1 : pasmsymbol);
-     constructor op_sym_ofs(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint);
-     constructor op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:pasmsymbol;_op2ofs : longint);
-     constructor op_sym_ofs_ref(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
+     constructor op_sym(op : tasmop;_op1 : tasmsymbol);
+     constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
+     constructor op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : longint);
+     constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
 
      procedure loadbool(opidx:longint;_b:boolean);
+     procedure loadconst(opidx:longint;l:longint);
+     procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+     procedure loadref(opidx:longint;p:preference);
+     procedure loadreg(opidx:longint;r:tregister);
+     procedure loadoper(opidx:longint;o:toper);
 
-     destructor done;virtual;
-  private
+     destructor destroy;override;
   end;
 
 
@@ -83,6 +85,93 @@ implementation
                                  taicpu Constructors
 *****************************************************************************}
 
+    procedure taicpu.loadconst(opidx:longint;l:longint);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            disposereference(ref);
+           val:=l;
+           typ:=top_const;
+         end;
+      end;
+
+
+    procedure taicpu.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            disposereference(ref);
+           sym:=s;
+           symofs:=sofs;
+           typ:=top_symbol;
+         end;
+        { Mark the symbol as used }
+        if assigned(s) then
+         inc(s.refs);
+      end;
+
+
+    procedure taicpu.loadref(opidx:longint;p:preference);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            disposereference(ref);
+           if p^.is_immediate then
+             begin
+{$ifdef REF_IMMEDIATE_WARN}
+               Comment(V_Warning,'Reference immediate');
+{$endif}
+               val:=p^.offset;
+               disposereference(p);
+               typ:=top_const;
+             end
+           else
+             begin
+               ref:=p;
+               typ:=top_ref;
+               { mark symbol as used }
+               if assigned(ref^.symbol) then
+                 inc(ref^.symbol.refs);
+             end;
+         end;
+      end;
+
+
+    procedure taicpu.loadreg(opidx:longint;r:tregister);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            disposereference(ref);
+           reg:=r;
+           typ:=top_reg;
+         end;
+      end;
+
+    procedure taicpu.loadoper(opidx:longint;o:toper);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        if oper[opidx].typ=top_ref then
+          disposereference(oper[opidx].ref);
+        oper[opidx]:=o;
+        { copy also the reference }
+        if oper[opidx].typ=top_ref then
+         oper[opidx].ref:=newreference(o.ref^);
+      end;
+
+
     procedure taicpu.loadbool(opidx:longint;_b:boolean);
       begin
         if opidx>=ops then
@@ -99,13 +188,13 @@ implementation
 
     constructor taicpu.op_none(op : tasmop);
       begin
-         inherited init(op);
+         inherited create(op);
       end;
 
 
     constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
          loadreg(0,_op1);
       end;
@@ -113,7 +202,7 @@ implementation
 
     constructor taicpu.op_const(op : tasmop;_op1 : longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
          loadconst(0,_op1);
       end;
@@ -121,7 +210,7 @@ implementation
 
     constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          loadreg(0,_op1);
          loadreg(1,_op2);
@@ -129,7 +218,7 @@ implementation
 
     constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          loadreg(0,_op1);
          loadconst(1,_op2);
@@ -137,7 +226,7 @@ implementation
 
      constructor taicpu.op_const_reg(op:tasmop; _op1: longint; _op2: tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          loadconst(0,_op1);
          loadreg(1,_op2);
@@ -146,7 +235,7 @@ implementation
 
     constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          loadreg(0,_op1);
          loadref(1,_op2);
@@ -155,7 +244,7 @@ implementation
 
     constructor taicpu.op_const_const(op : tasmop;_op1,_op2 : longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          loadconst(0,_op1);
          loadconst(1,_op2);
@@ -164,7 +253,7 @@ implementation
 
     constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          loadreg(0,_op1);
          loadreg(1,_op2);
@@ -173,16 +262,16 @@ implementation
 
      constructor taicpu.op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: Longint);
        begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          loadreg(0,_op1);
          loadreg(1,_op2);
          loadconst(2,_op3);
       end;
 
-     constructor taicpu.op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: pasmsymbol;_op3ofs: longint);
+     constructor taicpu.op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint);
        begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          loadreg(0,_op1);
          loadreg(1,_op2);
@@ -191,7 +280,7 @@ implementation
 
      constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;  _op3: preference);
        begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          loadreg(0,_op1);
          loadreg(1,_op2);
@@ -200,7 +289,7 @@ implementation
 
     constructor taicpu.op_const_reg_reg(op : tasmop;_op1 : longint;_op2, _op3 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          loadconst(0,_op1);
          loadreg(1,_op2);
@@ -209,7 +298,7 @@ implementation
 
      constructor taicpu.op_const_reg_const(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          loadconst(0,_op1);
          loadreg(1,_op2);
@@ -219,7 +308,7 @@ implementation
 
      constructor taicpu.op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=4;
          loadreg(0,_op1);
          loadreg(1,_op2);
@@ -229,7 +318,7 @@ implementation
 
      constructor taicpu.op_reg_bool_reg_reg(op : tasmop;_op1: tregister;_op2:boolean;_op3,_op4:tregister);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=4;
          loadreg(0,_op1);
          loadbool(1,_op2);
@@ -239,7 +328,7 @@ implementation
 
      constructor taicpu.op_reg_bool_reg_const(op : tasmop;_op1: tregister;_op2:boolean;_op3:tregister;_op4: longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=4;
          loadreg(0,_op1);
          loadbool(0,_op2);
@@ -249,7 +338,7 @@ implementation
 
      constructor taicpu.op_reg_reg_const_const_const(op : tasmop;_op1,_op2 : tregister;_op3,_op4,_op5 : Longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=5;
          loadreg(0,_op1);
          loadreg(1,_op2);
@@ -258,17 +347,17 @@ implementation
          loadconst(4,_op5);
       end;
 
-    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : pasmsymbol);
+    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
       begin
-         inherited init(op);
+         inherited create(op);
          condition:=cond;
          ops:=1;
          loadsymbol(0,_op1,0);
       end;
 
-     constructor taicpu.op_const_const_sym(op : tasmop;_op1,_op2 : longint; _op3: pasmsymbol);
+     constructor taicpu.op_const_const_sym(op : tasmop;_op1,_op2 : longint; _op3: tasmsymbol);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          loadconst(0,_op1);
          loadconst(1,_op2);
@@ -276,54 +365,58 @@ implementation
       end;
 
 
-    constructor taicpu.op_sym(op : tasmop;_op1 : pasmsymbol);
+    constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
          loadsymbol(0,_op1,0);
       end;
 
 
-    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint);
+    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
          loadsymbol(0,_op1,_op1ofs);
       end;
 
 
-     constructor taicpu.op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:pasmsymbol;_op2ofs : longint);
+     constructor taicpu.op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : longint);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          loadreg(0,_op1);
          loadsymbol(1,_op2,_op2ofs);
       end;
 
 
-    constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
+    constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          loadsymbol(0,_op1,_op1ofs);
          loadref(1,_op2);
       end;
 
-    destructor taicpu.done;
+    destructor taicpu.destroy;
       var
         i : longint;
       begin
           for i:=ops-1 downto 0 do
             if (oper[i].typ=top_ref) then
               dispose(oper[i].ref);
-        inherited done;
+        inherited destroy;
       end;
 
 end.
 {
   $Log$
-  Revision 1.1  2000-07-13 06:30:12  michael
-  + Initial import
+  Revision 1.2  2001-08-26 13:29:34  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:12  michael
+    + Initial import
 
   Revision 1.5  2000/01/07 01:14:58  peter
     * updated copyright to 2000
@@ -342,5 +435,4 @@ end.
 
   Revision 1.1  1999/08/03 23:37:53  jonas
     + initial implementation for PowerPC based on the Alpha stuff
-
-}
+}

+ 65 - 29
compiler/new/powerpc/cpubase.pas

@@ -21,13 +21,13 @@
  ****************************************************************************
 }
 unit cpubase;
+
+{$i defines.inc}
+
 interface
-{$ifdef TP}
-  {$L-,Y-}
-{$endif}
 
 uses
-  strings,cobjects,aasm,cpuinfo;
+  strings,cutils,cclasses,aasm,cpuinfo;
 
 {$ifndef NOOPT}
 Type
@@ -117,16 +117,11 @@ type
 
   op2strtable=array[tasmop] of string[8];
 
-
-
 const
-
   firstop = low(tasmop);
   lastop  = high(tasmop);
 
 
-
-
 {*****************************************************************************
                                   Registers
 *****************************************************************************}
@@ -202,6 +197,9 @@ Const
     'XER','LR','CTR','FPSCR'
   );
 
+  { FIX ME !!!!!!!!! }
+  ALL_REGISTERS = [R_0..R_FPSCR];
+
 
 {*****************************************************************************
                                 Conditions
@@ -211,11 +209,11 @@ type
 {$ifndef tp}
 {$minenumsize 1}
 {$endif tp}
-  TAsmCondFlags = (CF_None { unconditional junps },
+  TAsmCondFlags = (C_None { unconditional junps },
     { conditions when not using ctr decrement etc }
-    CF_LT,CF_LE,CF_EQ,CF_GE,CF_GT,CF_NL,CF_NE,CF_NG,CF_SO,CF_NS,CF_UN,CF_NU,
+    C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,C_NS,C_UN,C_NU,
     { conditions when using ctr decrement etc }
-    CF_T,CF_F,CF_DNZ,CF_DNZT,CF_DNZF,CF_DZ,CF_DZT,CF_DZF);
+    C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF);
 
 {$ifndef tp}
 {$minenumsize default}
@@ -225,13 +223,13 @@ type
                  false: (BO, BI: byte);
                  true: (
                    case cond: TAsmCondFlags of
-                     CF_None: ();
+                     C_None: ();
                      { specifies in which part of the cr the bit has to be }
                      { tested for blt,bgt,beq etc.                         }
-                     CF_LT,CF_LE,CF_EQ,CF_GE,CF_GT,CF_NL,CF_NE,CF_NG,CF_SO,
-                       CF_NS,CF_UN,CF_NU: (cr: R_CR0..R_CR7);
+                     C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,
+                       C_NS,C_UN,C_NU: (cr: R_CR0..R_CR7);
                      { specifies the bit to test for bt,bf,bdz etc. }
-                     CF_T,CF_F,CF_DNZ,CF_DNZT,CF_DNZF,CF_DZ,CF_DZT,CF_DZF:
+                     C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF:
                        (crbit: byte)
                    );
              end;
@@ -285,7 +283,7 @@ type
      is_immediate: boolean; { is this used as reference or immediate }
      base, index : tregister;
      offset      : longint;
-     symbol      : pasmsymbol;
+     symbol      : tasmsymbol;
      symaddr     : trefsymaddr;
      offsetfixup : longint;
      options     : trefoptions;
@@ -309,7 +307,7 @@ type
      top_reg    : (reg:tregister);
      top_ref    : (ref:preference);
      top_const  : (val:aword);
-     top_symbol : (sym:pasmsymbol;symofs:longint);
+     top_symbol : (sym:tasmsymbol;symofs:longint);
      top_bool  :  (b: boolean);
   end;
 
@@ -322,8 +320,8 @@ type
   TLoc=(
     LOC_INVALID,     { added for tracking problems}
     LOC_REGISTER,    { in a processor register }
-    LOC_CREGISTER,    { Constant register which shouldn't be modified }
-    LOC_FPUREGISTER, { FPU register }
+    LOC_CREGISTER,   { Constant register which shouldn't be modified }
+    LOC_FPU,         { FPU register, called LOC_FPU for historic reasons }
     LOC_CFPUREGISTER,{ Constant FPU register which shouldn't be modified }
     LOC_MMREGISTER,  { multimedia register }
     LOC_CMMREGISTER, { Constant multimedia reg which shouldn't be modified }
@@ -337,7 +335,7 @@ type
   tlocation = packed record
      case loc : tloc of
         LOC_MEM,LOC_REFERENCE : (reference : treference);
-        LOC_FPUREGISTER, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
+        LOC_FPU, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
           LOC_REGISTER,LOC_CREGISTER : (
             case longint of
               1 : (registerlow,registerhigh : tregister);
@@ -405,6 +403,12 @@ const
   max_scratch_regs = 3;
   scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_11,R_12,R_30);
 
+  { FIX ME !!!!!!!!! }
+  maxfpuvarregs = 4;
+
+  maxintregs = maxvarregs;
+  maxfpuregs = maxfpuvarregs;
+
 { low and high of the available maximum width integer general purpose }
 { registers                                                           }
   LoGPReg = R_0;
@@ -451,6 +455,10 @@ const
     procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
     procedure create_cond_norm(cond: TAsmCondFlags; cr: byte;var r : TasmCond);
 
+    procedure clear_location(var loc : tlocation);
+    procedure set_location(var destloc,sourceloc : tlocation);
+    procedure swap_location(var destloc,sourceloc : tlocation);
+
 {*****************************************************************************
                                   Init/Done
 *****************************************************************************}
@@ -520,9 +528,9 @@ implementation
 
     procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
     const
-      inv_condflags:array[TAsmCondFlags] of TAsmCondFlags=(CF_None,
-        CF_GE,CF_GT,CF_NE,CF_LT,CF_LE,CF_LT,CF_EQ,CF_GT,CF_NS,CF_SO,CF_NU,CF_UN,
-        CF_F,CF_T,CF_DNZ,CF_DNZF,CF_DNZT,CF_DZ,CF_DZF,CF_DZT);
+      inv_condflags:array[TAsmCondFlags] of TAsmCondFlags=(C_None,
+        C_GE,C_GT,C_NE,C_LT,C_LE,C_LT,C_EQ,C_GT,C_NS,C_SO,C_NU,C_UN,
+        C_F,C_T,C_DNZ,C_DNZF,C_DNZT,C_DZ,C_DZF,C_DZT);
     begin
       c.cond := inv_condflags[c.cond];
       r := c;
@@ -545,13 +553,37 @@ implementation
       c.simple := true;
       c.cond := cond;
       case cond of
-        CF_NONE:;
-        CF_T..CF_DZF: c.crbit := cr
+        C_NONE:;
+        C_T..C_DZF: c.crbit := cr
         else c.cr := cr2reg[cr];
       end;
       r := c;
     end;
 
+    procedure clear_location(var loc : tlocation);
+
+      begin
+        loc.loc:=LOC_INVALID;
+      end;
+
+    {This is needed if you want to be able to delete the string with the nodes !!}
+    procedure set_location(var destloc,sourceloc : tlocation);
+
+      begin
+        destloc:= sourceloc;
+      end;
+
+    procedure swap_location(var destloc,sourceloc : tlocation);
+
+      var
+         swapl : tlocation;
+
+      begin
+         swapl := destloc;
+         destloc := sourceloc;
+         sourceloc := swapl;
+      end;
+
 {*****************************************************************************
                                   Init/Done
 *****************************************************************************}
@@ -567,8 +599,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  2000-07-13 06:30:12  michael
-  + Initial import
+  Revision 1.2  2001-08-26 13:29:34  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:12  michael
+    + Initial import
 
   Revision 1.15  2000/05/01 11:04:49  jonas
     * changed NOT to A_NOP
@@ -606,7 +642,7 @@ end.
     * several changes to the way conditional branches are handled\n  * some typos fixed
 
   Revision 1.5  1999/08/23 23:27:54  pierre
-   + dummy InitCpu/DoneCpu
+    + dummy InitCpu/DoneCpu
 
   Revision 1.4  1999/08/06 16:41:12  jonas
     * PowerPC compiles again, several routines implemented in cgcpu.pas

+ 24 - 6
compiler/new/powerpc/cpuinfo.pas

@@ -2,7 +2,7 @@
     $Id$
     Copyright (c) 1998-2000 by the Free Pascal development team
 
-    Basic Processor information
+    Basic Processor information for the PowerPC
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -19,11 +19,22 @@ Interface
 
 Type
    { Architecture word - Native unsigned type }
-{$ifdef FPC}
    AWord = Dword;
-{$else FPC}
-   AWord = Longint;
-{$endif FPC}
+
+Type
+   { the ordinal type used when evaluating constant integer expressions }
+   TConstExprInt = int64;
+   { ... the same unsigned }
+   TConstExprUInt = {$ifdef fpc}qword{$else}int64{$endif};
+
+   { this must be an ordinal type with the same size as a pointer }
+   { to allow some dirty type casts for example when using        }
+   { tconstsym.value                                              }
+   { Note: must be unsigned!! Otherwise, ugly code like           }
+   { pointer(-1) will result in a pointer with the value          }
+   { $fffffffffffffff on a 32bit machine if the compiler uses     }
+   { int64 constants internally (JM)                              }
+   TPointerOrd = DWord;
 
 Const
    { Size of native extended type }
@@ -31,4 +42,11 @@ Const
 
 Implementation
 
-end.
+end.
+{
+  $Log$
+  Revision 1.2  2001-08-26 13:29:34  florian
+    * some cg reorganisation
+    * some PPC updates
+
+}

+ 302 - 0
compiler/powerpc/agas.pas

@@ -0,0 +1,302 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    This unit implements an asm 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 agas;
+
+  interface
+
+    uses
+       cpubase,dos,globals,systems,{errors,}cobjects,aasm,strings,files,
+       agatt
+{$ifdef GDB}
+       ,gdb
+{$endif GDB}
+       ;
+
+    type
+      paicpuattasmlist=^taicpuattasmlist;
+      taicpuattasmlist=object(tattasmlist)
+        function getreferencestring(var ref : treference) : string; Virtual;
+        function getopstr_jmp(const o:toper) : string; Virtual;
+
+        procedure WriteInstruction (HP : Pai); virtual;
+        function cond2str(op: tasmop; c: tasmcond): string;
+
+        { to construct the output for conditional branches }
+        function branchmode(o: tasmop): string[4];
+
+      end;
+
+  implementation
+
+    uses cpuasm;
+
+    const
+       att_op2str : array[tasmop] of string[14] = ('<none>',
+    'add','add.','addo','addo.','addc','addc.','addco','addco.',
+    'adde','adde.','addeo','addeo.','addi','addic','addic.','addis',
+    'addme','addme.','addmeo','addmeo.','addze','addze.','addzeo',
+    'addzeo.','and','and.','andc','andc.','andi.','andis.','b',
+    'ba','bl','bla','bc','bca','bcl','bcla','bcctr','bcctrl','bclr',
+    'bclrl','cmp','cmpi','cmpl','cmpli','cntlzw','cntlzw.','crand',
+    'crandc','creqv','crnand','crnor','cror','crorc','crxor','dcba',
+    'dcbf','dcbi','dcbst','dcbt','divw','divw.','divwo','divwo.',
+    'divwu','divwu.','divwuo','divwuo.','eciwx','ecowx','eieio','eqv',
+    'eqv.','extsb','extsb.','extsh','extsh.','fabs','fabs.','fadd',
+    'fadd.','fadds','fadds.','fcompo','fcmpu','fctiw','fctw.','fctwz',
+    'fctwz.','fdiv','fdiv.','fdivs','fdivs.','fmadd','fmadd.','fmadds',
+    'fmadds.','fmr','fmsub','fmsub.','fmsubs','fmsubs.','fmul','fmul.',
+    'fmuls','fmuls.','fnabs','fnabs.','fneg','fneg.','fnmadd',
+    'fnmadd.','fnmadds','fnmadds.','fnmsub','fnmsub.','fnmsubs',
+    'fnmsubs.','fres','fres.','frsp','frsp.','frsqrte','frsqrte.',
+    'fsel','fsel.','fsqrt','fsqrt.','fsqrts','fsqrts.','fsub','fsub.',
+    'fsubs','fsubs.','icbi','isync','lbz','lbzu','lbzux','lbzx',
+    'lfd','lfdu','lfdux','lfdx','lfs','lfsu','lfsux','lfsx','lha',
+    'lhau','lhaux','lhax','hbrx','lhz','lhzu','lhzux','lhzx','lmw',
+    'lswi','lswx','lwarx','lwbrx','lwz','lwzu','lwzux','lwzx','mcrf',
+    'mcrfs','lcrxe','mfcr','mffs','maffs.','mfmsr','mfspr','mfsr',
+    'mfsrin','mftb','mtfcrf','mtfd0','mtfsb1','mtfsf','mtfsf.',
+    'mtfsfi','mtfsfi.','mtmsr','mtspr','mtsr','mtsrin','mulhw',
+    'mulhw.','mulhwu','mulhwu.','mulli','mullh','mullw.','mullwo',
+    'mullwo.','nand','nand.','neg','neg.','nego','nego.','nor','nor.',
+    'or','or.','orc','orc.','ori','oris', 'rfi', 'rlwimi', 'rlwimi.',
+    'rlwinm', 'tlwinm.','rlwnm','sc','slw', 'slw.', 'sraw', 'sraw.',
+    'srawi', 'srawi.','srw', 'srw.', 'stb', 'stbu', 'stbux','stbx','stfd',
+    'stfdu', 'stfdux', 'stfdx', 'stfiwx', 'stfs', 'stfsu', 'stfsux', 'stfsx',
+    'sth', 'sthbrx', 'sthu', 'sthux', 'sthx', 'stmw', 'stswi', 'stswx', 'stw',
+    'stwbrx', 'stwx.', 'stwu', 'stwux', 'stwx', 'subf', 'subf.', 'subfo',
+    'subfo.', 'subfc', 'subc.', 'subfco', 'subfco.', 'subfe', 'subfe.',
+    'subfeo', 'subfeo.', 'subfic', 'subfme', 'subfme.', 'subfmeo', 'subfmeo.',
+    'subfze', 'subfze.', 'subfzeo', 'subfzeo.', 'sync', 'tlbia', 'tlbie',
+    'tlbsync', 'tw', 'twi', 'xor', 'xor.', 'xori', 'xoris',
+    { some simplified mnemonics }
+    'subi', 'subis', 'subic', 'subic.', 'sub', 'sub.', 'subo', 'subo.',
+    'subc', 'subc.', 'subco', '.subco.', 'cmpwi', 'cmpw', 'cmplwi', 'cmplw',
+    'extlwi', 'extlwi.', 'extrwi', 'extrwi.', 'inslwi', 'inslwi.', 'insrwi',
+    'insrwi.', 'rotlwi', 'rotlwi.', 'rotlw', 'rotlw.', 'slwi', 'slwi.',
+    'srwi', 'srwi.', 'clrlwi', 'clrlwi.', 'clrrwi', 'clrrwi.', 'clrslwi',
+    'clrslwi.', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove',
+    'crnot', 'mt', 'mf','nop', 'li', 'lis', 'la', 'mr','not', 'mtcr');
+
+    function taicpuattasmlist.getreferencestring(var ref : treference) : string;
+    var
+      s : string;
+    begin
+      if ref.is_immediate then
+       begin
+{$ifndef testing}
+         internalerror(1000101);
+         exit;
+{$else testing}
+         writeln('internalerror 1000101');
+         halt(1);
+{$endif testing}
+       end
+      else
+       begin
+         with ref do
+          begin
+            inc(offset,offsetfixup);
+            if (offset < -32768) or (offset > 32767) then
+{$ifndef testing}
+              internalerror(19991);
+{$else testing}
+              begin
+                writeln('internalerror 19991');
+                halt(1);
+              end;
+{$endif testing}
+            s:='';
+            if assigned(symbol) then
+             s:=s+symbol^.name + symaddr2str[symaddr];
+            if offset<0 then
+             s:=s+tostr(offset)
+            else
+             if (offset>0) then
+              begin
+                if assigned(symbol) then
+                 s:=s+'+'+tostr(offset)
+                else
+                 s:=s+tostr(offset);
+              end;
+             if (index=R_NO) and (base<>R_NO) then
+               s:=s+'('+att_reg2str[base]+')'
+             else if (index<>R_NO) and (base<>R_NO) and (offset = 0) then
+               s:=s+att_reg2str[base]+','+att_reg2str[index]
+             else if ((index<>R_NO) or (base<>R_NO)) then
+{$ifndef testing}
+              internalerror(19992);
+{$else testing}
+              begin
+                writeln('internalerror 19992');
+                halt(1);
+              end;
+{$endif testing}
+          end;
+       end;
+      getreferencestring:=s;
+    end;
+
+    function taicpuattasmlist.getopstr_jmp(const o:toper) : string;
+    var
+      hs : string;
+    begin
+      case o.typ of
+        top_reg :
+          getopstr_jmp:=att_reg2str[o.reg];
+        { no top_ref jumping for powerpc }
+        top_const :
+          getopstr_jmp:=tostr(o.val);
+        top_symbol :
+          begin
+            hs:=o.sym^.name;
+            if o.symofs>0 then
+             hs:=hs+'+'+tostr(o.symofs)
+            else
+             if o.symofs<0 then
+              hs:=hs+tostr(o.symofs);
+            getopstr_jmp:=hs;
+          end;
+        else
+{$ifndef testing}
+          internalerror(10001);
+{$else testing}
+          begin
+            writeln('internalerror 10001');
+            halt(1);
+          end;
+{$endif testing}
+      end;
+    end;
+
+
+    Procedure taicpuattasmlist.WriteInstruction (HP : Pai);
+    var op: TAsmOp;
+        s: string;
+        i: byte;
+        sep: string[3];
+    begin
+      op:=paicpu(hp)^.opcode;
+      if is_calljmp(op) then
+    { direct BO/BI in op[0] and op[1] not supported, put them in condition! }
+        s:=s+cond2str(op,paicpu(hp)^.condition)+
+           getopstr_jmp(paicpu(hp)^.oper[0])
+      else
+    { process operands }
+        begin
+          s:=#9+att_op2str[op];
+          if paicpu(hp)^.ops<>0 then
+            begin
+              if not is_calljmp(op) then
+                sep := ','
+              else sep := '#9';
+              for i:=0 to paicpu(hp)^.ops-1 do
+              begin
+                s:=s+sep+getopstr(paicpu(hp)^.oper[i])
+                sep:=',';
+              end;
+            end;
+        end;
+      AsmWriteLn(s);
+    end;
+
+    function taicpuattasmlist.cond2str(op: tasmop; c: tasmcond): string;
+    { note: no checking is performed whether the given combination of }
+    { conditions is valid                                             }
+    var tempstr: sintrg;
+    begin
+      tempstr := '#9';
+      case c.simple of
+        false: cond2str := tempstr+att_op2str[op]+'#9'+tostr(c.bo)+','+
+                           tostr(c.bi);
+        true:
+          if (op >= A_B) and (op <= A_BCLRL) then
+            case c.cond of
+              { unconditional branch }
+              CF_NONE: condstr := tempstr+op2str(op);
+              { bdnzt etc }
+              else
+                begin
+                  tempstr := tempstr+'b'+asmcondflag2str[c.cond]+
+                              branchmode(op)+'#9';
+                  case op of
+                    CF_LT..CF_NU:
+                      cond2str := tempstr+att_reg2str[c.cr];
+                    CF_T..CF_DZF:
+                      cond2str := tempstr+tostr(c.crbit);
+                  end;
+                end;
+            end
+          { we have a trap instruction }
+          { not yet implementer !!!!!!!!!!!!!!!!!!!!! }
+{          else
+            begin
+              case tempstr := 'tw';}
+      end;
+    end;
+
+    function taicpuattasmlist.branchmode(o: tasmop): string[4];
+      var tempstr: string[4];
+      begin
+        tempstr := '';
+        case o of
+          A_BCCTR,A_BCCTRL: tempstr := 'ctr'
+          A_BCLR,A_BCLRL: tempstr := 'lr'
+        case o of
+          A_BL,A_BLA,A_BCL,A_BCLA,A_BCCTRL,A_BCLRL: tempstr := tempstr+'l';
+        end;
+        case o of
+          A_BA,A_BLA,A_BCA,A_BCLA: tempstr:=tempstr+'a';
+        end;
+        branchmode := tempstr;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:31:04  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:12  michael
+  + Initial import
+
+  Revision 1.6  2000/05/01 11:03:32  jonas
+    * some fixes, does not yet compile
+
+  Revision 1.5  2000/03/26 16:37:36  jonas
+    + use cpubase unit
+    - removed use of alpha unit
+
+  Revision 1.4  2000/01/07 01:14:57  peter
+    * updated copyright to 2000
+
+  Revision 1.3  1999/09/03 13:15:47  jonas
+    + implemented most necessary methods
+
+  Revision 1.2  1999/08/25 12:00:22  jonas
+    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
+
+  Revision 1.1  1999/08/03 23:37:52  jonas
+    + initial implementation for PowerPC based on the Alpha stuff
+
+}

+ 59 - 0
compiler/powerpc/aoptcpu.pas

@@ -0,0 +1,59 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit implements the PowerPC optimizer object
+
+    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 aoptcpu;
+
+Interface
+
+uses cpubase, aoptobj, aoptcpub;
+
+Type
+  TAOptCpu = Object(TAoptObj)
+    { uses the same constructor as TAopObj }
+  End;
+
+Implementation
+
+End.
+{
+ $Log$
+ Revision 1.1  2001-08-26 13:31:04  florian
+   * some cg reorganisation
+   * some PPC updates
+
+ Revision 1.2  2001/08/26 13:29:33  florian
+   * some cg reorganisation
+   * some PPC updates
+
+ Revision 1.1  2000/07/13 06:30:12  michael
+   + Initial import
+
+ Revision 1.2  2000/01/07 01:14:57  peter
+   * updated copyright to 2000
+
+ Revision 1.1  1999/12/24 22:49:23  jonas
+   + dummy to allow compiling
+
+}

+ 136 - 0
compiler/powerpc/aoptcpub.pas

@@ -0,0 +1,136 @@
+ {
+    $Id$
+    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains several types and constants necessary for the
+    optimizer to work on the 80x86 architecture
+
+    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 aoptcpub; { Assembler OPTimizer CPU specific Base }
+
+{ enable the following define if memory references can have both a base and }
+{ index register in 1 operand                                               }
+
+{$define RefsHaveIndexReg}
+
+{ enable the following define if memory references can have a scaled index }
+
+{ define RefsHaveScale}
+
+{ enable the following define if memory references can have a segment }
+{ override                                                            }
+
+{ define RefsHaveSegment}
+
+Interface
+
+Uses
+  CPUAsm,AOptBase;
+
+Type
+
+{ type of a normal instruction }
+  TInstr = Taicpu;
+  PInstr = ^TInstr;
+
+{ ************************************************************************* }
+{ **************************** TCondRegs ********************************** }
+{ ************************************************************************* }
+{ Info about the conditional registers                                      }
+  TCondRegs = Object
+    Constructor Init;
+    Destructor Done;
+  End;
+
+{ ************************************************************************* }
+{ **************************** TAoptBaseCpu ******************************* }
+{ ************************************************************************* }
+
+  TAoptBaseCpu = Object(TAoptBase)
+  End;
+
+
+{ ************************************************************************* }
+{ ******************************* Constants ******************************* }
+{ ************************************************************************* }
+Const
+
+{ the maximum number of things (registers, memory, ...) a single instruction }
+{ changes                                                                    }
+
+  MaxCh = 3;
+
+{ the maximum number of operands an instruction has }
+
+  MaxOps = 3;
+
+{Oper index of operand that contains the source (reference) with a load }
+{instruction                                                            }
+
+  LoadSrc = 0;
+
+{Oper index of operand that contains the destination (register) with a load }
+{instruction                                                                }
+
+  LoadDst = 1;
+
+{Oper index of operand that contains the source (register) with a store }
+{instruction                                                            }
+
+  StoreSrc = 0;
+
+{Oper index of operand that contains the destination (reference) with a load }
+{instruction                                                                 }
+
+  StoreDst = 1;
+
+Implementation
+
+{ ************************************************************************* }
+{ **************************** TCondRegs ********************************** }
+{ ************************************************************************* }
+Constructor TCondRegs.init;
+Begin
+End;
+
+Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
+Begin
+End;
+
+End.
+
+{
+ $Log$
+ Revision 1.1  2001-08-26 13:31:04  florian
+   * some cg reorganisation
+   * some PPC updates
+
+ Revision 1.1  2000/07/13 06:30:12  michael
+ + Initial import
+
+ Revision 1.3  2000/03/26 16:38:27  jonas
+   + basic properties
+
+ Revision 1.2  2000/01/07 01:14:57  peter
+   * updated copyright to 2000
+
+ Revision 1.1  1999/11/09 22:57:09  peter
+   * compiles again both i386,alpha both with optimizer
+
+}

+ 55 - 0
compiler/powerpc/aoptcpuc.pas

@@ -0,0 +1,55 @@
+ {
+    $Id$
+    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains the processor specific implementation of the
+    assembler optimizer common subexpression elimination object.
+
+    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 aoptcpuc;
+
+Interface
+
+Uses
+  AOptCs;
+
+Type
+  TRegInfoCpu = Object(TRegInfo)
+  End;
+
+
+Implementation
+
+End.
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:31:04  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:12  michael
+  + Initial import
+
+  Revision 1.2  2000/01/07 01:14:57  peter
+    * updated copyright to 2000
+
+  Revision 1.1  1999/11/09 22:57:09  peter
+    * compiles again both i386,alpha both with optimizer
+
+}

+ 57 - 0
compiler/powerpc/aoptcpud.pas

@@ -0,0 +1,57 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+    Development Team
+
+    This unit contains the processor specific implementation of the
+    assembler optimizer data flow analyzer.
+
+    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 aoptcpud;
+
+Interface
+
+uses
+  AOptDA;
+
+Type
+  PAOptDFACpu = ^TAOptDFACpu;
+  TAOptDFACpu = Object(TAOptDFA)
+  End;
+
+Implementation
+
+
+End.
+
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:31:04  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:12  michael
+  + Initial import
+
+  Revision 1.2  2000/01/07 01:14:57  peter
+    * updated copyright to 2000
+
+  Revision 1.1  1999/11/09 22:57:09  peter
+    * compiles again both i386,alpha both with optimizer
+
+}

+ 47 - 0
compiler/powerpc/cga.pas

@@ -0,0 +1,47 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    Helper routines for the i386 code generator
+
+    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 cga;
+
+{$i defines.inc}
+
+interface
+
+    uses
+       cpubase,cpuasm,
+       symconst,symtype,symdef,aasm;
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:31:04  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2001/08/26 13:29:33  florian
+    * some cg reorganisation
+    * some PPC updates
+
+}

+ 811 - 0
compiler/powerpc/cgcpu.pas

@@ -0,0 +1,811 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 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 a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel);
+
+
+          procedure g_stackframe_entry_sysv(list : paasmoutput;localsize : longint);
+          procedure g_stackframe_entry_mac(list : paasmoutput;localsize : longint);
+          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 g_return_from_proc_sysv(list : paasmoutput;parasize : aword);
+          procedure g_return_from_proc_mac(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
+
+          { 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_NONE,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,systems;
+
+{ 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;
+          op: tasmop;
+
+      begin
+        if cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE] then
+          op := A_CMP
+        else op := A_CMPL;
+        list^.concat(new(paicpu,op_const_reg_reg(op,0,reg1,reg2)));
+        a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l);
+      end;
+
+     procedure tcgppc.a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel);
+
+        begin
+          a_jmp(list,A_BC,TOpCmp2AsmCond[cond],l);
+        end;
+
+{ *********** entry/exit code and address loading ************ }
+
+    procedure tcgppc.g_stackframe_entry(list : paasmoutput;localsize : longint);
+    begin
+      case target_os.id of
+        os_powerpc_macos:
+          g_stackframe_entry_mac(list,localsize);
+        os_powerpc_linux:
+          g_stackframe_entry_sysv(list,localsize)
+        else
+          internalerror(2204001);
+      end;
+    end;
+
+
+    procedure tcgppc.g_stackframe_entry_sysv(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 regcounter: 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         }
+        { following is the entry code as described in "Altivec Programming }
+        { Interface Manual", bar the saving of AltiVec registers           }
+        a_reg_alloc(list,stack_pointer);
+        a_reg_alloc(list,R_0);
+        { allocate registers containing reg parameters }
+        for regcounter := R_3 to R_10 do
+          a_reg_alloc(list,regcounter);
+        { save return address... }
+        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_LR)));
+        { ... in caller's frame }
+        list^.concat(new(paicpu,op_reg_ref(A_STW,R_0,new_reference(STACK_POINTER,4))));
+        a_reg_dealloc(list,R_0);
+        a_reg_alloc(list,R_11);
+        { save end of fpr save area }
+        list^.concat(new(paicpu,op_reg_reg_const(A_ORI,R_11,STACK_POINTER,0)));
+        a_reg_alloc(list,R_12);
+        { 0 or 8 based on SP alignment }
+        list^.concat(new(paicpu,op_reg_reg_const_const_const(A_RLWINM,
+          R_12,STACK_POINTER,0,28,28)));
+        { add in stack length }
+        list^.concat(new(paicpu,op_reg_reg_const(A_SUBFIC,R_12,R_12,
+          -localsize)));
+        { establish new alignment }
+        list^.concat(new(paicpu,op_reg_reg_reg(A_STWUX,STACK_POINTER,STACK_POINTER,R_12)));
+        a_reg_dealloc(list,R_12);
+        { save floating-point registers }
+        { !!! has to be optimized: only save registers that are used }
+        list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_savefpr_14'),0)));
+        { compute end of gpr save area }
+        list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_11,R_11,-144)));
+        { save gprs and fetch GOT pointer }
+        { !!! has to be optimized: only save registers that are used }
+        list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_savegpr_14_go'),0)));
+        a_reg_alloc(list,R_31);
+        { place GOT ptr in r31 }
+        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_31,R_LR)));
+        { save the CR if necessary ( !!! always done currently ) }
+        { still need to find out where this has to be done for SystemV
+        a_reg_alloc(list,R_0);
+        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_CR);
+        list^.concat(new(paicpu,op_reg_ref(A_STW,scratch_register,
+          new_reference(stack_pointer,LA_CR))));
+        a_reg_dealloc(list,R_0); }
+        { save pointer to incoming arguments }
+        list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_30,R_11,144)));
+        { now comes the AltiVec context save, not yet implemented !!! }
+       end;
+
+    procedure tcgppc.g_stackframe_entry_mac(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 regcounter: 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         }
+        { following is the entry code as described in "Altivec Programming }
+        { Interface Manual", bar the saving of AltiVec registers           }
+        a_reg_alloc(list,STACK_POINTER);
+        a_reg_alloc(list,R_0);
+        { allocate registers containing reg parameters }
+        for regcounter := R_3 to R_10 do
+          a_reg_alloc(list,regcounter);
+        { save return address... }
+        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_LR)));
+        { ... in caller's frame }
+        list^.concat(new(paicpu,op_reg_ref(A_STW,R_0,new_reference(STACK_POINTER,8))));
+        a_reg_dealloc(list,R_0);
+        { save floating-point registers }
+        { !!! has to be optimized: only save registers that are used }
+        list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_savef14'),0)));
+        { save gprs in gpr save area }
+        { !!! has to be optimized: only save registers that are used }
+        list^.concat(new(paicpu,op_reg_ref(A_STMW,R_13,new_reference(STACK_POINTER,-220))));
+        { save the CR if necessary ( !!! always done currently ) }
+        a_reg_alloc(list,R_0);
+        list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_CR)));
+        list^.concat(new(paicpu,op_reg_ref(A_STW,R_0,
+          new_reference(stack_pointer,LA_CR))));
+        a_reg_dealloc(list,R_0);
+        { save pointer to incoming arguments }
+        list^.concat(new(paicpu,op_reg_reg_const(A_ORI,R_31,STACK_POINTER,0)));
+        a_reg_alloc(list,R_12);
+        { 0 or 8 based on SP alignment }
+        list^.concat(new(paicpu,op_reg_reg_const_const_const(A_RLWINM,
+          R_12,STACK_POINTER,0,28,28)));
+        { add in stack length }
+        list^.concat(new(paicpu,op_reg_reg_const(A_SUBFIC,R_12,R_12,
+          -localsize)));
+        { establish new alignment }
+        list^.concat(new(paicpu,op_reg_reg_reg(A_STWUX,STACK_POINTER,STACK_POINTER,R_12)));
+        a_reg_dealloc(list,R_12);
+        { now comes the AltiVec context save, not yet implemented !!! }
+       end;
+
+
+    procedure tcgppc.g_restore_frame_pointer(list : paasmoutput);
+
+      begin
+ { no frame pointer on the PowerPC (maybe there is one in the SystemV ABI?)}
+      end;
+
+    procedure tcgppc.g_return_from_proc(list : paasmoutput;parasize : aword);
+    begin
+      case target_os.id of
+        os_powerpc_macos:
+          g_return_from_proc_mac(list,parasize);
+        os_powerpc_linux:
+          g_return_from_proc_sysv(list,parasize)
+        else
+          internalerror(2204001);
+      end;
+    end;
+
+
+     procedure tcgppc.g_return_from_proc_sysv(list : paasmoutput;parasize : aword);
+
+     var regcounter: TRegister;
+
+     begin
+       { release parameter registers }
+       for regcounter := R_3 to R_10 do
+         a_reg_dealloc(list,regcounter);
+       { AltiVec context restore, not yet implemented !!! }
+
+       { address of gpr save area to r11 }
+       list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_11,R_31,-144)));
+       { restore gprs }
+       list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_restgpr_14'),0)));
+       { address of fpr save area to r11 }
+       list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_11,R_11,144)));
+       { restore fprs and return }
+       list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_restfpr_14_x'),0)));
+     end;
+
+     procedure tcgppc.g_return_from_proc_mac(list : paasmoutput;parasize : aword);
+
+     var regcounter: TRegister;
+
+     begin
+       { release parameter registers }
+       for regcounter := R_3 to R_10 do
+         a_reg_dealloc(list,regcounter);
+       { AltiVec context restore, not yet implemented !!! }
+
+       { restore SP }
+       list^.concat(new(paicpu,op_reg_reg_const(A_ORI,STACK_POINTER,R_31,0)));
+       { restore gprs }
+       list^.concat(new(paicpu,op_reg_ref(A_LMW,R_13,new_reference(STACK_POINTER,-220))));
+       { restore return address ... }
+       list^.concat(new(paicpu,op_reg_ref(A_LWZ,R_0,new_reference(STACK_POINTER,8))));
+       { ... and return from _restf14 }
+       list^.concat(new(paicpu,op_sym_ofs(A_B,newasmsymbol('_restf14'),0)));
+     end;
+
+     procedure tcgppc.a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);
+
+     var tmpreg: tregister;
+         ref, tmpref: treference;
+
+       begin
+         ref := ref2;
+         FixRef(ref);
+         if assigned(ref.symbol) then
+           { add the symbol's value to the base of the reference, and if the }
+           { reference doesn't have a base, create one                       }
+           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;
+             ref.symaddr := refs_l;
+             { can be folded with one of the next instructions by the }
+             { optimizer probably                                     }
+             list^.concat(new(paicpu,op_reg_reg_ref(A_ADDI,tmpreg,tmpreg,
+                newreference(tmpref))));
+           end;
+         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)));
+         if assigned(ref.symbol) then
+           free_scratch_reg(list,tmpreg);
+       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
+            { the offsets are zero after the a_loadaddress_ref_reg and just }
+            { have to be set to 4. I put an Inc there so debugging may be   }
+            { easier (should offset be different from zero here, it will be }
+            { easy to notice in the genreated assembler                     }
+            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);
+            { explicitely allocate R_0 since it can be used safely here }
+            { (for holding date that's being copied)                    }
+            tempreg := R_0;
+            a_reg_alloc(list,R_0);
+            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;
+       a_reg_dealloc(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;
+            ref.symaddr := refs_l;
+          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)));
+      create_cond_norm(c,0,p^.condition);
+      list^.concat(p)
+    end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:31:04  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.2  2001/08/26 13:29:33  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:12  michael
+    + Initial import
+
+  Revision 1.12  2000/04/22 14:25:04  jonas
+    * aasm.pas: pai_align instead of pai_align_abstract if cpu <> i386
+    + systems.pas: info for macos/ppc
+    * new/cgobj.pas: compiles again without newst define
+    * new/powerpc/cgcpu: generate different entry/exit code depending on
+      whether target_os is MacOs or Linux
+
+  Revision 1.11  2000/01/07 01:14:57  peter
+    * updated copyright to 2000
+
+  Revision 1.10  1999/12/24 22:48:10  jonas
+    * compiles again
+
+  Revision 1.9  1999/11/05 07:05:56  jonas
+    + a_jmp_cond()
+
+  Revision 1.8  1999/10/24 09:22:18  jonas
+    + entry/exitcode for SystemV (Linux) and AIX/Mac from the Altivec
+      PIM (no AltiVec support yet though)
+    * small fix to the a_cmp_* methods
+
+  Revision 1.7  1999/10/20 12:23:24  jonas
+    * fixed a_loadaddress_ref_reg (mentioned as ToDo in rev. 1.5)
+    * small bugfix in a_load_store
+
+  Revision 1.6  1999/09/15 20:35:47  florian
+    * small fix to operator overloading when in MMX mode
+    + the compiler uses now fldz and fld1 if possible
+    + some fixes to floating point registers
+    + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
+    * .... ???
+
+  Revision 1.5  1999/09/03 13:14:11  jonas
+    + implemented some parameter passing methods, but they require
+      some more helper routines
+    * fix for loading symbol addresses (still needs to be done in a_loadaddress)
+    * 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
+}

+ 442 - 0
compiler/powerpc/cpuasm.pas

@@ -0,0 +1,442 @@
+{
+    $Id$
+    Copyright (c) 1999-2001 by Jonas Maebe
+
+    Contains the assembler object 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 cpuasm;
+
+interface
+
+uses
+  cclasses,
+  aasm,globals,verbose,tainst,
+  cpubase;
+
+type
+
+  taicpu = class(tainstruction)
+     constructor op_none(op : tasmop);
+
+     constructor op_reg(op : tasmop;_op1 : tregister);
+     constructor op_const(op : tasmop;_op1 : longint);
+
+     constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
+     constructor op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
+     constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
+     constructor op_const_reg(op:tasmop; _op1: longint; _op2: tregister);
+
+     constructor op_const_const(op : tasmop;_op1,_op2 : longint);
+
+     constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
+     constructor op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: Longint);
+     constructor op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint);
+     constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; _op3: preference);
+     constructor op_const_reg_reg(op : tasmop;_op1 : longint;_op2, _op3 : tregister);
+     constructor op_const_reg_const(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : longint);
+
+     constructor op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister);
+     constructor op_reg_bool_reg_reg(op : tasmop;_op1: tregister;_op2:boolean;_op3,_op4:tregister);
+     constructor op_reg_bool_reg_const(op : tasmop;_op1: tregister;_op2:boolean;_op3:tregister;_op4: longint);
+
+     constructor op_reg_reg_const_const_const(op : tasmop;_op1,_op2 : tregister;_op3,_op4,_op5 : Longint);
+
+
+     { this is for Jmp instructions }
+     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
+     constructor op_const_const_sym(op : tasmop;_op1,_op2 : longint;_op3: tasmsymbol);
+
+
+     constructor op_sym(op : tasmop;_op1 : tasmsymbol);
+     constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
+     constructor op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : longint);
+     constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
+
+     procedure loadbool(opidx:longint;_b:boolean);
+     procedure loadconst(opidx:longint;l:longint);
+     procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+     procedure loadref(opidx:longint;p:preference);
+     procedure loadreg(opidx:longint;r:tregister);
+     procedure loadoper(opidx:longint;o:toper);
+
+     destructor destroy;override;
+  end;
+
+
+implementation
+
+{*****************************************************************************
+                                 taicpu Constructors
+*****************************************************************************}
+
+    procedure taicpu.loadconst(opidx:longint;l:longint);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            disposereference(ref);
+           val:=l;
+           typ:=top_const;
+         end;
+      end;
+
+
+    procedure taicpu.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            disposereference(ref);
+           sym:=s;
+           symofs:=sofs;
+           typ:=top_symbol;
+         end;
+        { Mark the symbol as used }
+        if assigned(s) then
+         inc(s.refs);
+      end;
+
+
+    procedure taicpu.loadref(opidx:longint;p:preference);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            disposereference(ref);
+           if p^.is_immediate then
+             begin
+{$ifdef REF_IMMEDIATE_WARN}
+               Comment(V_Warning,'Reference immediate');
+{$endif}
+               val:=p^.offset;
+               disposereference(p);
+               typ:=top_const;
+             end
+           else
+             begin
+               ref:=p;
+               typ:=top_ref;
+               { mark symbol as used }
+               if assigned(ref^.symbol) then
+                 inc(ref^.symbol.refs);
+             end;
+         end;
+      end;
+
+
+    procedure taicpu.loadreg(opidx:longint;r:tregister);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            disposereference(ref);
+           reg:=r;
+           typ:=top_reg;
+         end;
+      end;
+
+    procedure taicpu.loadoper(opidx:longint;o:toper);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        if oper[opidx].typ=top_ref then
+          disposereference(oper[opidx].ref);
+        oper[opidx]:=o;
+        { copy also the reference }
+        if oper[opidx].typ=top_ref then
+         oper[opidx].ref:=newreference(o.ref^);
+      end;
+
+
+    procedure taicpu.loadbool(opidx:longint;_b:boolean);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            disposereference(ref);
+           b:=_b;
+           typ:=top_bool;
+         end;
+      end;
+
+
+    constructor taicpu.op_none(op : tasmop);
+      begin
+         inherited create(op);
+      end;
+
+
+    constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
+      begin
+         inherited create(op);
+         ops:=1;
+         loadreg(0,_op1);
+      end;
+
+
+    constructor taicpu.op_const(op : tasmop;_op1 : longint);
+      begin
+         inherited create(op);
+         ops:=1;
+         loadconst(0,_op1);
+      end;
+
+
+    constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
+      begin
+         inherited create(op);
+         ops:=2;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+    constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
+      begin
+         inherited create(op);
+         ops:=2;
+         loadreg(0,_op1);
+         loadconst(1,_op2);
+      end;
+
+     constructor taicpu.op_const_reg(op:tasmop; _op1: longint; _op2: tregister);
+      begin
+         inherited create(op);
+         ops:=2;
+         loadconst(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
+      begin
+         inherited create(op);
+         ops:=2;
+         loadreg(0,_op1);
+         loadref(1,_op2);
+      end;
+
+
+    constructor taicpu.op_const_const(op : tasmop;_op1,_op2 : longint);
+      begin
+         inherited create(op);
+         ops:=2;
+         loadconst(0,_op1);
+         loadconst(1,_op2);
+      end;
+
+
+    constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
+      begin
+         inherited create(op);
+         ops:=3;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+         loadreg(2,_op3);
+      end;
+
+     constructor taicpu.op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: Longint);
+       begin
+         inherited create(op);
+         ops:=3;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+         loadconst(2,_op3);
+      end;
+
+     constructor taicpu.op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint);
+       begin
+         inherited create(op);
+         ops:=3;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+         loadsymbol(0,_op3,_op3ofs);
+      end;
+
+     constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;  _op3: preference);
+       begin
+         inherited create(op);
+         ops:=3;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+         loadref(2,_op3);
+      end;
+
+    constructor taicpu.op_const_reg_reg(op : tasmop;_op1 : longint;_op2, _op3 : tregister);
+      begin
+         inherited create(op);
+         ops:=3;
+         loadconst(0,_op1);
+         loadreg(1,_op2);
+         loadreg(2,_op3);
+      end;
+
+     constructor taicpu.op_const_reg_const(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : longint);
+      begin
+         inherited create(op);
+         ops:=3;
+         loadconst(0,_op1);
+         loadreg(1,_op2);
+         loadconst(2,_op3);
+      end;
+
+
+     constructor taicpu.op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister);
+      begin
+         inherited create(op);
+         ops:=4;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+         loadreg(2,_op3);
+         loadreg(3,_op4);
+      end;
+
+     constructor taicpu.op_reg_bool_reg_reg(op : tasmop;_op1: tregister;_op2:boolean;_op3,_op4:tregister);
+      begin
+         inherited create(op);
+         ops:=4;
+         loadreg(0,_op1);
+         loadbool(1,_op2);
+         loadreg(2,_op3);
+         loadreg(3,_op4);
+      end;
+
+     constructor taicpu.op_reg_bool_reg_const(op : tasmop;_op1: tregister;_op2:boolean;_op3:tregister;_op4: longint);
+      begin
+         inherited create(op);
+         ops:=4;
+         loadreg(0,_op1);
+         loadbool(0,_op2);
+         loadreg(0,_op3);
+         loadconst(0,_op4);
+      end;
+
+     constructor taicpu.op_reg_reg_const_const_const(op : tasmop;_op1,_op2 : tregister;_op3,_op4,_op5 : Longint);
+      begin
+         inherited create(op);
+         ops:=5;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+         loadconst(2,_op3);
+         loadconst(3,_op4);
+         loadconst(4,_op5);
+      end;
+
+    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
+      begin
+         inherited create(op);
+         condition:=cond;
+         ops:=1;
+         loadsymbol(0,_op1,0);
+      end;
+
+     constructor taicpu.op_const_const_sym(op : tasmop;_op1,_op2 : longint; _op3: tasmsymbol);
+      begin
+         inherited create(op);
+         ops:=3;
+         loadconst(0,_op1);
+         loadconst(1,_op2);
+         loadsymbol(2,_op3,0);
+      end;
+
+
+    constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
+      begin
+         inherited create(op);
+         ops:=1;
+         loadsymbol(0,_op1,0);
+      end;
+
+
+    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
+      begin
+         inherited create(op);
+         ops:=1;
+         loadsymbol(0,_op1,_op1ofs);
+      end;
+
+
+     constructor taicpu.op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : longint);
+      begin
+         inherited create(op);
+         ops:=2;
+         loadreg(0,_op1);
+         loadsymbol(1,_op2,_op2ofs);
+      end;
+
+
+    constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
+      begin
+         inherited create(op);
+         ops:=2;
+         loadsymbol(0,_op1,_op1ofs);
+         loadref(1,_op2);
+      end;
+
+    destructor taicpu.destroy;
+      var
+        i : longint;
+      begin
+          for i:=ops-1 downto 0 do
+            if (oper[i].typ=top_ref) then
+              dispose(oper[i].ref);
+        inherited destroy;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.2  2001-08-26 13:31:04  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.2  2001/08/26 13:29:34  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:12  michael
+    + Initial import
+
+  Revision 1.5  2000/01/07 01:14:58  peter
+    * updated copyright to 2000
+
+  Revision 1.4  1999/08/25 12:00:24  jonas
+    * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
+
+  Revision 1.3  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.2  1999/08/04 12:59:24  jonas
+    * all tokes now start with an underscore
+    * PowerPC compiles!!
+
+  Revision 1.1  1999/08/03 23:37:53  jonas
+    + initial implementation for PowerPC based on the Alpha stuff
+}

+ 667 - 0
compiler/powerpc/cpubase.pas

@@ -0,0 +1,667 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    Contains the base types 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 cpubase;
+
+{$i defines.inc}
+
+interface
+
+uses
+  strings,cutils,cclasses,aasm,cpuinfo;
+
+{$ifndef NOOPT}
+Type
+{What an instruction can change}
+  TInsChange = (Ch_None);
+{$endif}
+
+const
+{ Size of the instruction table converted by nasmconv.pas }
+  instabentries = 1103;
+  maxinfolen    = 7;
+
+{ By default we want everything }
+{$define ATTOP}
+{$define ATTREG}
+{$define INTELOP}
+{$define ITTABLE}
+
+{ For TP we can't use asmdebug due the table sizes }
+{$ifndef TP}
+  {$define ASMDEBUG}
+{$endif}
+
+{ We Don't need the intel style opcodes if we don't have a intel }
+{ reader or generator                                            }
+{$undef INTELOP}
+
+{ We Don't need the AT&T style opcodes if we don't have a AT&T
+  reader or generator }
+{$ifdef NORA386ATT}
+  {$ifdef NOAG386ATT}
+    {$undef ATTOP}
+    {$ifdef NOAG386DIR}
+       {$undef ATTREG}
+    {$endif}
+  {$endif}
+{$endif}
+
+type
+  TAsmOp=(A_None,
+    { normal opcodes }
+    a_add, a_add_, a_addo, a_addo_, a_addc, a_addc_, a_addco, a_addco_,
+    a_adde, a_adde_, a_addeo, a_addeo_, a_addi, a_addic, a_addic_, a_addis,
+    a_addme, a_addme_, a_addmeo, a_addmeo_, a_addze, a_addze_, a_addzeo,
+    a_addzeo_, a_and, a_and_, a_andc, a_andc_, a_andi_, a_andis_, a_b,
+    a_ba, a_bl, a_bla, a_bc, a_bca, a_bcl, a_bcla, a_bcctr, a_bcctrl, a_bclr,
+    a_bclrl, a_cmp, a_cmpi, a_cmpl, a_cmpli, a_cntlzw, a_cntlzw_, a_crand,
+    a_crandc, a_creqv, a_crnand, a_crnor, a_cror, a_crorc, a_crxor, a_dcba,
+    a_dcbf, a_dcbi, a_dcbst, a_dcbt, a_divw, a_divw_, a_divwo, a_divwo_,
+    a_divwu, a_divwu_, a_divwuo, a_divwuo_, a_eciwx, a_ecowx, a_eieio, a_eqv,
+    a_eqv_, a_extsb, a_extsb_, a_extsh, a_extsh_, a_fabs, a_fabs_, a_fadd,
+    a_fadd_, a_fadds, a_fadds_, a_fcompo, a_fcmpu, a_fctiw, a_fctw_, a_fctwz,
+    a_fctwz_, a_fdiv, a_fdiv_, a_fdivs, a_fdivs_, a_fmadd, a_fmadd_, a_fmadds,
+    a_fmadds_, a_fmr, a_fmsub, a_fmsub_, a_fmsubs, a_fmsubs_, a_fmul, a_fmul_,
+    a_fmuls, a_fmuls_, a_fnabs, a_fnabs_, a_fneg, a_fneg_, a_fnmadd,
+    a_fnmadd_, a_fnmadds, a_fnmadds_, a_fnmsub, a_fnmsub_, a_fnmsubs,
+    a_fnmsubs_, a_fres, a_fres_, a_frsp, a_frsp_, a_frsqrte, a_frsqrte_,
+    a_fsel, a_fsel_, a_fsqrt, a_fsqrt_, a_fsqrts, a_fsqrts_, a_fsub, a_fsub_,
+    a_fsubs, a_fsubs_, a_icbi, a_isync, a_lbz, a_lbzu, a_lbzux, a_lbzx,
+    a_lfd, a_lfdu, a_lfdux, a_lfdx, a_lfs, a_lfsu, a_lfsux, a_lfsx, a_lha,
+    a_lhau, a_lhaux, a_lhax, a_hbrx, a_lhz, a_lhzu, a_lhzux, a_lhzx, a_lmw,
+    a_lswi, a_lswx, a_lwarx, a_lwbrx, a_lwz, a_lwzu, a_lwzux, a_lwzx, a_mcrf,
+    a_mcrfs, a_lcrxe, a_mfcr, a_mffs, a_maffs_, a_mfmsr, a_mfspr, a_mfsr,
+    a_mfsrin, a_mftb, a_mtfcrf, a_a_mtfd0, a_mtfsb1, a_mtfsf, a_mtfsf_,
+    a_mtfsfi, a_mtfsfi_, a_mtmsr, a_mtspr, a_mtsr, a_mtsrin, a_mulhw,
+    a_mulhw_, a_mulhwu, a_mulhwu_, a_mulli, a_mullw, a_mullw_, a_mullwo,
+    a_mullwo_, a_nand, a_nand_, a_neg, a_neg_, a_nego, a_nego_, a_nor, a_nor_,
+    a_or, a_or_, a_orc, a_orc_, a_ori, a_oris, a_rfi, a_rlwimi, a_rlwimi_,
+    a_rlwinm, a_tlwinm_, a_rlwnm, a_sc, a_slw, a_slw_, a_sraw, a_sraw_,
+    a_srawi, a_srawi_,a_srw, a_srw_, a_stb, a_stbu, a_stbux, a_stbx, a_stfd,
+    a_stfdu, a_stfdux, a_stfdx, a_stfiwx, a_stfs, a_stfsu, a_stfsux, a_stfsx,
+    a_sth, a_sthbrx, a_sthu, a_sthux, a_sthx, a_stmw, a_stswi, a_stswx, a_stw,
+    a_stwbrx, a_stwx_, a_stwu, a_stwux, a_stwx, a_subf, a_subf_, a_subfo,
+    a_subfo_, a_subfc, a_subfc_, a_subfco, a_subfco_, a_subfe, a_subfe_,
+    a_subfeo, a_subfeo_, a_subfic, a_subfme, a_subfme_, a_subfmeo, a_subfmeo_,
+    a_subfze, a_subfze_, a_subfzeo, a_subfzeo_, a_sync, a_tlbia, a_tlbie,
+    a_tlbsync, a_tw, a_twi, a_xor, a_xor_, a_xori, a_xoris,
+    { simplified mnemonics }
+    a_subi, a_subis, a_subic, a_subic_, a_sub, a_sub_, a_subo, a_subo_,
+    a_subc, a_subc_, a_subco, _subco_, a_cmpwi, a_cmpw, a_cmplwi, a_cmplw,
+    a_extlwi, a_extlwi_, a_extrwi, a_extrwi_, a_inslwi, a_inslwi_, a_insrwi,
+    a_insrwi_, a_rotlwi, a_rotlwi_, a_rotlw, a_rotlw_, a_slwi, a_slwi_,
+    a_srwi, a_srwi_, a_clrlwi, a_clrlwi_, a_clrrwi, a_clrrwi_, a_clrslwi,
+    a_clrslwi_, a_blr, a_bctr, a_blrl, a_bctrl, a_crset, a_crclr, a_crmove,
+    a_crnot, a_mt {move to special prupose reg}, a_mf {move from special purpose reg},
+    a_nop, a_li, a_lis, a_la, a_mr, a_not, a_mtcr);
+
+  op2strtable=array[tasmop] of string[8];
+
+const
+  firstop = low(tasmop);
+  lastop  = high(tasmop);
+
+
+{*****************************************************************************
+                                  Registers
+*****************************************************************************}
+
+type
+  tregister = (R_NO,
+    R_0,R_1,R_2,R_3,R_4,R_5,R_6,R_7,R_8,R_9,R_10,R_11,R_12,R_13,R_14,R_15,R_16,
+    R_17,R_18,R_19,R_20,R_21,R_22,R_23,R_24,R_25,R_26,R_27,R_28,R_29,R_30,R_31,
+    R_F0,R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,R_F10,R_F11,R_F12,
+    R_F13,R_F14,R_F15,R_F16,R_F17, R_F18,R_F19,R_F20,R_F21,R_F22, R_F23,R_F24,
+    R_F25,R_F26,R_F27,R_F28,R_F29,R_F30,R_F31,
+    R_M0,R_M1,R_M2,R_M3,R_M4,R_M5,R_M6,R_M7,R_M8,R_M9,R_M10,R_M11,R_M12,
+    R_M13,R_M14,R_M15,R_M16,R_M17,R_M18,R_M19,R_M20,R_M21,R_M22, R_M23,R_M24,
+    R_M25,R_M26,R_M27,R_M28,R_M29,R_M30,R_M31,
+
+    R_CR,R_CR0,R_CR1,R_CR2,R_CR3,R_CR4,R_CR5,R_CR6,R_CR7,
+    R_XER,R_LR,R_CTR,R_FPSCR
+  );
+
+  tregisterset = set of tregister;
+
+  reg2strtable = array[tregister] of string[5];
+
+Const
+   R_SPR1 = R_XER;
+   R_SPR8 = R_LR;
+   R_SPR9 = R_CTR;
+   R_TOC = R_2;
+{   CR0 = 0;
+   CR1 = 4;
+   CR2 = 8;
+   CR3 = 12;
+   CR4 = 16;
+   CR5 = 20;
+   CR6 = 24;
+   CR7 = 28;
+   LT = 0;
+   GT = 1;
+   EQ = 2;
+   SO = 3;
+   FX = 4;
+   FEX = 5;
+   VX = 6;
+   OX = 7;}
+
+  firstreg = low(tregister);
+  lastreg  = high(tregister);
+
+  att_reg2str : reg2strtable = ('',
+    '0','1','2','3','4','5','6','7','8','9','10','11','12','13','14','15','16',
+    '17','18','19','20','21','22','23','24','25','26','27','28','29','30','31',
+    'F0','F1','F2','F3','F4','F5','F6','F7', 'F8','F9','F10','F11','F12',
+    'F13','F14','F15','F16','F17', 'F18','F19','F20','F21','F22', 'F23','F24',
+    'F25','F26','F27','F28','F29','F30','F31',
+    'M0','M1','M2','M3','M4','M5','M6','M7','M8','M9','M10','M11','M12',
+    'M13','M14','M15','M16','M17','M18','M19','M20','M21','M22', 'M23','M24',
+    'M25','M26','M27','M28','M29','M30','M31',
+    'CR','CR0','CR1','CR2','CR3','CR4','CR5','CR6','CR7',
+    'XER','LR','CTR','FPSCR'
+  );
+
+  mot_reg2str : reg2strtable = ('',
+    'r0','r1','r2','r3','r4','r5','r6','r7','r8','r9','r10','r11','r12','r13',
+    'r14','r15','r16','r17','r18','r19','r20','r21','r22','r23','r24','r25',
+    'r26','r27','r28','r29','r30','r31',
+    'F0','F1','F2','F3','F4','F5','F6','F7', 'F8','F9','F10','F11','F12',
+    'F13','F14','F15','F16','F17', 'F18','F19','F20','F21','F22', 'F23','F24',
+    'F25','F26','F27','F28','F29','F30','F31',
+    'M0','M1','M2','M3','M4','M5','M6','M7','M8','M9','M10','M11','M12',
+    'M13','M14','M15','M16','M17','M18','M19','M20','M21','M22', 'M23','M24',
+    'M25','M26','M27','M28','M29','M30','M31',
+    'CR','CR0','CR1','CR2','CR3','CR4','CR5','CR6','CR7',
+    'XER','LR','CTR','FPSCR'
+  );
+
+  { FIX ME !!!!!!!!! }
+  ALL_REGISTERS = [R_0..R_FPSCR];
+
+
+{*****************************************************************************
+                                Conditions
+*****************************************************************************}
+
+type
+{$ifndef tp}
+{$minenumsize 1}
+{$endif tp}
+  TAsmCondFlags = (C_None { unconditional junps },
+    { conditions when not using ctr decrement etc }
+    C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,C_NS,C_UN,C_NU,
+    { conditions when using ctr decrement etc }
+    C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF);
+
+{$ifndef tp}
+{$minenumsize default}
+{$endif tp}
+  TAsmCond = packed record
+               case simple: boolean of
+                 false: (BO, BI: byte);
+                 true: (
+                   case cond: TAsmCondFlags of
+                     C_None: ();
+                     { specifies in which part of the cr the bit has to be }
+                     { tested for blt,bgt,beq etc.                         }
+                     C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,
+                       C_NS,C_UN,C_NU: (cr: R_CR0..R_CR7);
+                     { specifies the bit to test for bt,bf,bdz etc. }
+                     C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF:
+                       (crbit: byte)
+                   );
+             end;
+
+const
+{  AsmCondFlag2BO: Array[TAsmCondFlags] of Byte =
+    (0,12,4,12,4,12,4,4,4,12,4,12,4,
+    );
+  AsmCondFlag2BI: Array[TAsmCondFlags] of Byte =
+    (0,0,1,2,0,1,0,2,1,3,3,3,3);}
+
+  AsmCondFlag2Str: Array[tasmcondflags] of string[2] = ({cf_none}'',
+     { conditions when not using ctr decrement etc}
+     'lt','le','eq','ge','gt','nl','ne','ng','so','ns','un','nu',
+     't','f','dnz','dzt','dnzf','dz','dzt','dzf');
+
+
+
+const
+  CondAsmOps=3;
+  CondAsmOp:array[0..CondAsmOps-1] of TasmOp=(
+     A_BC, A_TW, A_TWI
+  );
+{*****************************************************************************
+                                   Flags
+*****************************************************************************}
+
+type
+  TResFlags = (F_LT,F_GT,F_EQ,F_SO,F_FX,F_FEX,F_VX,F_OX);
+(*
+const
+  { arrays for boolean location conversions }
+  flag_2_cond : array[TResFlags] of TAsmCond =
+     (C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE);
+*)
+
+{*****************************************************************************
+                                Reference
+*****************************************************************************}
+
+type
+  trefoptions=(ref_none,ref_parafixup,ref_localfixup);
+
+  { since we have only 16 offsets, we need to be able to specify the high }
+  { and low 16 bits of the address of a symbol                            }
+  trefsymaddr = (refs_full,refs_ha,refs_l);
+
+  { immediate/reference record }
+  preference = ^treference;
+  treference = packed record
+     is_immediate: boolean; { is this used as reference or immediate }
+     base, index : tregister;
+     offset      : longint;
+     symbol      : tasmsymbol;
+     symaddr     : trefsymaddr;
+     offsetfixup : longint;
+     options     : trefoptions;
+     alignment   : byte;
+  end;
+
+const symaddr2str: array[trefsymaddr] of string[3] = ('','@ha','@l');
+
+
+{*****************************************************************************
+                                Operand
+*****************************************************************************}
+
+type
+  toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_bool);
+
+  toper=record
+    ot  : longint;
+    case typ : toptype of
+     top_none   : ();
+     top_reg    : (reg:tregister);
+     top_ref    : (ref:preference);
+     top_const  : (val:aword);
+     top_symbol : (sym:tasmsymbol;symofs:longint);
+     top_bool  :  (b: boolean);
+  end;
+
+
+{*****************************************************************************
+                               Generic Location
+*****************************************************************************}
+
+type
+  TLoc=(
+    LOC_INVALID,     { added for tracking problems}
+    LOC_REGISTER,    { in a processor register }
+    LOC_CREGISTER,   { Constant register which shouldn't be modified }
+    LOC_FPU,         { FPU register, called LOC_FPU for historic reasons }
+    LOC_CFPUREGISTER,{ Constant FPU register which shouldn't be modified }
+    LOC_MMREGISTER,  { multimedia register }
+    LOC_CMMREGISTER, { Constant multimedia reg which shouldn't be modified }
+    LOC_MEM,         { in memory }
+    LOC_REFERENCE,   { like LOC_MEM, but lvalue }
+    LOC_JUMP,        { boolean results only, jump to false or true label }
+    LOC_FLAGS        { boolean results only, flags are set }
+  );
+
+  plocation = ^tlocation;
+  tlocation = packed record
+     case loc : tloc of
+        LOC_MEM,LOC_REFERENCE : (reference : treference);
+        LOC_FPU, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
+          LOC_REGISTER,LOC_CREGISTER : (
+            case longint of
+              1 : (registerlow,registerhigh : tregister);
+              { overlay a registerlow }
+              2 : (register : tregister);
+            );
+
+        LOC_JUMP : ();
+        LOC_FLAGS : (resflags : tresflags);
+        LOC_INVALID : ();
+
+        { segment in reference at the same place as in loc_register }
+  end;
+
+
+{*****************************************************************************
+                                 Constants
+*****************************************************************************}
+
+const
+  availabletempregsint = [R_11..R_30];
+  availabletempregsfpu = [R_F14..R_F31];
+  availabletempregsmm  = [R_M0..R_M31];
+
+  lvaluelocations = [LOC_REFERENCE, LOC_CREGISTER, LOC_CFPUREGISTER,
+                     LOC_CMMREGISTER];
+
+  c_countusableregsint = 21;
+  c_countusableregsfpu = 32;
+  c_countusableregsmm  = 32;
+
+  max_operands = 5;
+
+  maxvarregs = 18;
+
+  varregs : Array [1..maxvarregs] of Tregister =
+            (R_13,R_14,R_15,R_16,R_17,R_18,R_19,R_20,R_21,R_22,R_23,R_24,R_25,
+             R_26,R_27,R_28,R_29,R_30);
+
+  max_param_regs_int = 8;
+  param_regs_int: Array[1..max_param_regs_int] of tregister =
+    (R_3,R_4,R_5,R_6,R_7,R_8,R_9,R_10);
+
+  max_param_regs_fpu = 13;
+  param_regs_fpu: Array[1..max_param_regs_fpu] of tregister =
+    (R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,R_F10,R_F11,R_F12,R_F13);
+
+  general_registers = [R_0..R_31];
+
+  intregs = [R_0..R_31];
+  fpuregs = [R_F0..R_F31];
+  mmregs = [R_M0..R_M31];
+
+  cpuflags = [];
+
+  registers_saved_on_cdecl = [R_13..R_29];
+
+  { generic register names }
+  stack_pointer = R_1;
+  R_RTOC        = R_2;
+  frame_pointer = stack_pointer;
+  self_pointer  = R_9;
+  accumulator   = R_3;
+  vmt_offset_reg = R_0;
+  max_scratch_regs = 3;
+  scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_11,R_12,R_30);
+
+  { FIX ME !!!!!!!!! }
+  maxfpuvarregs = 4;
+
+  maxintregs = maxvarregs;
+  maxfpuregs = maxfpuvarregs;
+
+{ low and high of the available maximum width integer general purpose }
+{ registers                                                           }
+  LoGPReg = R_0;
+  HiGPReg = R_31;
+
+{ low and high of every possible width general purpose register (same as }
+{ above on most architctures apart from the 80x86)                       }
+  LoReg = R_0;
+  HiReg = R_31;
+
+(*  cpuflags : set of tcpuflags = []; *)
+
+  { sizes }
+  pointersize   = 4;
+  extended_size = 8;
+
+  LinkageAreaSize = 24;
+ { offset in the linkage area for the saved stack pointer }
+  LA_SP = 0;
+ { offset in the linkage area for the saved conditional register}
+  LA_CR = 4;
+ { offset in the linkage area for the saved link register}
+  LA_LR = 8;
+ { offset in the linkage area for the saved RTOC register}
+  LA_RTOC = 20;
+
+{*****************************************************************************
+                                  Helpers
+*****************************************************************************}
+
+    { resets all values of ref to defaults }
+    procedure reset_reference(var ref : treference);
+    { set mostly used values of a new reference }
+    function new_reference(base : tregister;offset : longint) : preference;
+
+    function newreference(const r : treference) : preference;
+    procedure disposereference(var r : preference);
+
+    function reg2str(r : tregister) : string;
+
+    function is_calljmp(o:tasmop):boolean;
+
+    procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
+    procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
+    procedure create_cond_norm(cond: TAsmCondFlags; cr: byte;var r : TasmCond);
+
+    procedure clear_location(var loc : tlocation);
+    procedure set_location(var destloc,sourceloc : tlocation);
+    procedure swap_location(var destloc,sourceloc : tlocation);
+
+{*****************************************************************************
+                                  Init/Done
+*****************************************************************************}
+
+  procedure InitCpu;
+  procedure DoneCpu;
+
+
+implementation
+
+{$ifdef heaptrc}
+  uses
+      ppheap;
+{$endif heaptrc}
+
+{*****************************************************************************
+                                  Helpers
+*****************************************************************************}
+
+    function reg2str(r : tregister) : string;
+      begin
+         reg2str:=mot_reg2str[r];
+      end;
+
+
+    function is_calljmp(o:tasmop):boolean;
+      begin
+       is_calljmp:=false;
+        case o of
+          A_B,A_BA,A_BL,A_BLA,A_BC,A_BCA,A_BCL,A_BCLA,A_BCCTR,A_BCCTRL,A_BCLR,
+            A_BCLRL,A_TW,A_TWI: is_calljmp:=true;
+        end;
+      end;
+
+    procedure disposereference(var r : preference);
+      begin
+         dispose(r);
+         r:=nil;
+      end;
+
+
+    function newreference(const r : treference) : preference;
+      var
+         p : preference;
+      begin
+         new(p);
+         p^:=r;
+         newreference:=p;
+      end;
+
+    procedure reset_reference(var ref : treference);
+      begin
+        FillChar(ref,sizeof(treference),0)
+      end;
+
+    function new_reference(base : tregister;offset : longint) : preference;
+    var
+      r : preference;
+    begin
+      new(r);
+      FillChar(r^,sizeof(treference),0);
+      r^.base:=base;
+      r^.offset:=offset;
+      new_reference:=r;
+    end;
+
+
+    procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
+    const
+      inv_condflags:array[TAsmCondFlags] of TAsmCondFlags=(C_None,
+        C_GE,C_GT,C_NE,C_LT,C_LE,C_LT,C_EQ,C_GT,C_NS,C_SO,C_NU,C_UN,
+        C_F,C_T,C_DNZ,C_DNZF,C_DNZT,C_DZ,C_DZF,C_DZT);
+    begin
+      c.cond := inv_condflags[c.cond];
+      r := c;
+    end;
+
+    procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
+    var c: tasmcond;
+    begin
+      c.simple := false;
+      c.bo := bo;
+      c.bi := bi;
+      r := c
+    end;
+
+    procedure create_cond_norm(cond: TAsmCondFlags; cr: byte;var r : TasmCond);
+    const cr2reg: array[0..7] of tregister =
+            (R_CR0,R_CR1,R_CR2,R_CR3,R_CR4,R_CR5,R_CR6,R_CR7);
+    var c: tasmcond;
+    begin
+      c.simple := true;
+      c.cond := cond;
+      case cond of
+        C_NONE:;
+        C_T..C_DZF: c.crbit := cr
+        else c.cr := cr2reg[cr];
+      end;
+      r := c;
+    end;
+
+    procedure clear_location(var loc : tlocation);
+
+      begin
+        loc.loc:=LOC_INVALID;
+      end;
+
+    {This is needed if you want to be able to delete the string with the nodes !!}
+    procedure set_location(var destloc,sourceloc : tlocation);
+
+      begin
+        destloc:= sourceloc;
+      end;
+
+    procedure swap_location(var destloc,sourceloc : tlocation);
+
+      var
+         swapl : tlocation;
+
+      begin
+         swapl := destloc;
+         destloc := sourceloc;
+         sourceloc := swapl;
+      end;
+
+{*****************************************************************************
+                                  Init/Done
+*****************************************************************************}
+
+  procedure InitCpu;
+    begin
+    end;
+
+  procedure DoneCpu;
+    begin
+    end;
+
+end.
+{
+  $Log$
+  Revision 1.2  2001-08-26 13:31:04  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.2  2001/08/26 13:29:34  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:12  michael
+    + Initial import
+
+  Revision 1.15  2000/05/01 11:04:49  jonas
+    * changed NOT to A_NOP
+
+  Revision 1.14  2000/04/29 09:01:06  jonas
+    * nmem compiles again (at least for powerpc)
+
+  Revision 1.13  2000/03/26 16:38:06  jonas
+    * frame_pointer = stackpointer instead of R_NO
+
+  Revision 1.12  2000/01/07 01:14:58  peter
+    * updated copyright to 2000
+
+  Revision 1.11  1999/12/24 22:48:10  jonas
+    * compiles again
+
+  Revision 1.10  1999/11/09 22:57:09  peter
+    * compiles again both i386,alpha both with optimizer
+
+  Revision 1.9  1999/10/20 12:21:34  jonas
+    * changed scratch_registers to (R_11,_R12,R_30) because R_0 is a special
+      case and R_31 is used as some kind of frame pointer under LinuxPPC
+
+  Revision 1.8  1999/10/14 14:57:55  florian
+    - removed the hcodegen use in the new cg, use cgbase instead
+
+  Revision 1.7  1999/09/15 20:35:47  florian
+    * small fix to operator overloading when in MMX mode
+    + the compiler uses now fldz and fld1 if possible
+    + some fixes to floating point registers
+    + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
+    * .... ???
+
+  Revision 1.6  1999/09/03 13:11:59  jonas
+    * several changes to the way conditional branches are handled\n  * some typos fixed
+
+  Revision 1.5  1999/08/23 23:27:54  pierre
+    + dummy InitCpu/DoneCpu
+
+  Revision 1.4  1999/08/06 16:41:12  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.3  1999/08/05 14:58:18  florian
+    * some fixes for the floating point registers
+    * more things for the new code generator
+
+  Revision 1.2  1999/08/04 12:59:25  jonas
+    * all tokes now start with an underscore
+    * PowerPC compiles!!
+
+  Revision 1.1  1999/08/03 23:37:53  jonas
+    + initial implementation for PowerPC based on the Alpha stuff
+
+}

+ 56 - 0
compiler/powerpc/cpuinfo.pas

@@ -0,0 +1,56 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by the Free Pascal development team
+
+    Basic Processor information for the PowerPC
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+Unit CPUInfo;
+
+Interface
+
+Type
+   { Architecture word - Native unsigned type }
+   AWord = Dword;
+
+Type
+   { the ordinal type used when evaluating constant integer expressions }
+   TConstExprInt = int64;
+   { ... the same unsigned }
+   TConstExprUInt = {$ifdef fpc}qword{$else}int64{$endif};
+
+   { this must be an ordinal type with the same size as a pointer }
+   { to allow some dirty type casts for example when using        }
+   { tconstsym.value                                              }
+   { Note: must be unsigned!! Otherwise, ugly code like           }
+   { pointer(-1) will result in a pointer with the value          }
+   { $fffffffffffffff on a 32bit machine if the compiler uses     }
+   { int64 constants internally (JM)                              }
+   TPointerOrd = DWord;
+
+Const
+   { Size of native extended type }
+   extended_size = 8;
+
+Implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:31:04  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.2  2001/08/26 13:29:34  florian
+    * some cg reorganisation
+    * some PPC updates
+
+}

+ 183 - 0
compiler/powerpc/tgcpu.pas

@@ -0,0 +1,183 @@
+{
+    $Id$
+    Copyright (C) 1998-2000 by Florian Klaempfl
+
+    This unit handles the temporary variables stuff for 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 tgcpu;
+
+  interface
+
+    uses
+       globals,
+       cgbase,verbose,aasm,
+       node,
+       cpuinfo,cpubase,cpuasm;
+
+    const
+       { this value is used in tsaved, if the register isn't saved }
+       reg_not_saved = $7fffffff;
+
+    type
+       tpushed = array[R_NO..R_NO] of boolean;
+       tsaved = array[R_NO..R_NO] of longint;
+
+    var
+       { tries to hold the amount of times which the current tree is processed  }
+       t_times : longint;
+
+    function getregisterint : tregister;
+    procedure ungetregisterint(r : tregister);
+    { tries to allocate the passed register, if possible }
+    function getexplicitregisterint(r : tregister) : tregister;
+
+    procedure ungetregister(r : tregister);
+
+    procedure cleartempgen;
+    procedure del_reference(const ref : treference);
+    procedure del_locref(const location : tlocation);
+    procedure del_location(const l : tlocation);
+
+    { pushs and restores registers }
+    procedure pushusedregisters(var pushed : tpushed;b : byte);
+    procedure popusedregisters(const pushed : tpushed);
+
+    { saves and restores used registers to temp. values }
+    procedure saveusedregisters(var saved : tsaved;b : byte);
+    procedure restoreusedregisters(const saved : tsaved);
+
+    { increments the push count of all registers in b}
+    procedure incrementregisterpushed(regs : tregisterset);
+
+    procedure clearregistercount;
+    procedure resetusableregisters;
+
+    type
+       regvar_longintarray = array[0..32+32-1] of longint;
+       regvar_booleanarray = array[0..32+32-1] of boolean;
+       regvar_ptreearray = array[0..32+32-1] of tnode;
+
+    var
+       unused,usableregs : tregisterset;
+
+       { uses only 1 byte while a set uses in FPC 32 bytes }
+       usedinproc : byte;
+
+       { count, how much a register must be pushed if it is used as register }
+       { variable                                                           }
+       reg_pushes : regvar_longintarray;
+       is_reg_var : regvar_booleanarray;
+
+
+implementation
+
+    uses
+      globtype,temp_gen;
+
+
+    function getregisterint : tregister;
+      begin
+      end;
+
+    procedure ungetregisterint(r : tregister);
+      begin
+      end;
+
+    { tries to allocate the passed register, if possible }
+    function getexplicitregisterint(r : tregister) : tregister;
+      begin
+      end;
+
+    procedure ungetregister(r : tregister);
+      begin
+      end;
+
+    procedure cleartempgen;
+      begin
+      end;
+
+    procedure del_reference(const ref : treference);
+      begin
+      end;
+
+    procedure del_locref(const location : tlocation);
+      begin
+      end;
+
+    procedure del_location(const l : tlocation);
+      begin
+      end;
+
+    { pushs and restores registers }
+    procedure pushusedregisters(var pushed : tpushed;b : byte);
+      begin
+      end;
+
+    procedure popusedregisters(const pushed : tpushed);
+      begin
+      end;
+
+    { saves and restores used registers to temp. values }
+    procedure saveusedregisters(var saved : tsaved;b : byte);
+      begin
+      end;
+
+    procedure restoreusedregisters(const saved : tsaved);
+      begin
+      end;
+
+    { increments the push count of all registers in b}
+    procedure incrementregisterpushed(regs : tregisterset);
+      begin
+      end;
+
+    procedure clearregistercount;
+      begin
+      end;
+
+    procedure resetusableregisters;
+      begin
+      end;
+
+begin
+   resetusableregisters;
+end.
+{
+  $Log$
+  Revision 1.1  2001-08-26 13:31:04  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.2  2001/08/26 13:23:23  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.1  2000/07/13 06:30:13  michael
+    + Initial import
+
+  Revision 1.3  2000/01/07 01:14:58  peter
+    * updated copyright to 2000
+
+  Revision 1.2  1999/08/04 12:59:26  jonas
+    * all tokes now start with an underscore
+    * PowerPC compiles!!
+
+  Revision 1.1  1999/08/03 23:37:53  jonas
+    + initial implementation for PowerPC based on the Alpha stuff
+}