Bläddra i källkod

* some cg reorganisation
* some PPC updates

florian 24 år sedan
förälder
incheckning
525be77ced

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

@@ -39,8 +39,12 @@ Implementation
 End.
 End.
 {
 {
  $Log$
  $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
  Revision 1.2  2000/01/07 01:14:57  peter
    * updated copyright to 2000
    * updated copyright to 2000
@@ -48,4 +52,4 @@ End.
  Revision 1.1  1999/12/24 22:49:23  jonas
  Revision 1.1  1999/12/24 22:49:23  jonas
    + dummy to allow compiling
    + 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.
 end.
 {
 {
   $Log$
   $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
   Revision 1.12  2000/04/22 14:25:04  jonas
     * aasm.pas: pai_align instead of pai_align_abstract if cpu <> i386
     * 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
     * PowerPC compiles again, several routines implemented in cgcpu.pas
     * added constant to cpubase of alpha and powerpc for maximum
     * added constant to cpubase of alpha and powerpc for maximum
       number of operands
       number of operands
-
-
 }
 }

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

@@ -1,6 +1,6 @@
 {
 {
     $Id$
     $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
+    Copyright (c) 1999-2001 by Jonas Maebe
 
 
     Contains the assembler object for the PowerPC
     Contains the assembler object for the PowerPC
 
 
@@ -25,15 +25,13 @@ unit cpuasm;
 interface
 interface
 
 
 uses
 uses
-  cobjects,
-  aasm,globals,verbose,
-  cpubase, tainst;
+  cclasses,
+  aasm,globals,verbose,tainst,
+  cpubase;
 
 
 type
 type
 
 
-  paicpu = ^taicpu;
-  taicpu = object(tainstruction)
-
+  taicpu = class(tainstruction)
      constructor op_none(op : tasmop);
      constructor op_none(op : tasmop);
 
 
      constructor op_reg(op : tasmop;_op1 : tregister);
      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_reg(op : tasmop;_op1,_op2,_op3 : tregister);
      constructor op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: Longint);
      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_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_reg(op : tasmop;_op1 : longint;_op2, _op3 : tregister);
      constructor op_const_reg_const(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : longint);
      constructor op_const_reg_const(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : longint);
@@ -61,19 +59,23 @@ type
 
 
 
 
      { this is for Jmp instructions }
      { 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 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;
   end;
 
 
 
 
@@ -83,6 +85,93 @@ implementation
                                  taicpu Constructors
                                  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);
     procedure taicpu.loadbool(opidx:longint;_b:boolean);
       begin
       begin
         if opidx>=ops then
         if opidx>=ops then
@@ -99,13 +188,13 @@ implementation
 
 
     constructor taicpu.op_none(op : tasmop);
     constructor taicpu.op_none(op : tasmop);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
       end;
       end;
 
 
 
 
     constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
     constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
          ops:=1;
          loadreg(0,_op1);
          loadreg(0,_op1);
       end;
       end;
@@ -113,7 +202,7 @@ implementation
 
 
     constructor taicpu.op_const(op : tasmop;_op1 : longint);
     constructor taicpu.op_const(op : tasmop;_op1 : longint);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
          ops:=1;
          loadconst(0,_op1);
          loadconst(0,_op1);
       end;
       end;
@@ -121,7 +210,7 @@ implementation
 
 
     constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
     constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          ops:=2;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadreg(1,_op2);
          loadreg(1,_op2);
@@ -129,7 +218,7 @@ implementation
 
 
     constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
     constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          ops:=2;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadconst(1,_op2);
          loadconst(1,_op2);
@@ -137,7 +226,7 @@ implementation
 
 
      constructor taicpu.op_const_reg(op:tasmop; _op1: longint; _op2: tregister);
      constructor taicpu.op_const_reg(op:tasmop; _op1: longint; _op2: tregister);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          ops:=2;
          loadconst(0,_op1);
          loadconst(0,_op1);
          loadreg(1,_op2);
          loadreg(1,_op2);
@@ -146,7 +235,7 @@ implementation
 
 
     constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
     constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          ops:=2;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadref(1,_op2);
          loadref(1,_op2);
@@ -155,7 +244,7 @@ implementation
 
 
     constructor taicpu.op_const_const(op : tasmop;_op1,_op2 : longint);
     constructor taicpu.op_const_const(op : tasmop;_op1,_op2 : longint);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          ops:=2;
          loadconst(0,_op1);
          loadconst(0,_op1);
          loadconst(1,_op2);
          loadconst(1,_op2);
@@ -164,7 +253,7 @@ implementation
 
 
     constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
     constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          ops:=3;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadreg(1,_op2);
          loadreg(1,_op2);
@@ -173,16 +262,16 @@ implementation
 
 
      constructor taicpu.op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: Longint);
      constructor taicpu.op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: Longint);
        begin
        begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          ops:=3;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadreg(1,_op2);
          loadreg(1,_op2);
          loadconst(2,_op3);
          loadconst(2,_op3);
       end;
       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
        begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          ops:=3;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadreg(1,_op2);
          loadreg(1,_op2);
@@ -191,7 +280,7 @@ implementation
 
 
      constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;  _op3: preference);
      constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;  _op3: preference);
        begin
        begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          ops:=3;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadreg(1,_op2);
          loadreg(1,_op2);
@@ -200,7 +289,7 @@ implementation
 
 
     constructor taicpu.op_const_reg_reg(op : tasmop;_op1 : longint;_op2, _op3 : tregister);
     constructor taicpu.op_const_reg_reg(op : tasmop;_op1 : longint;_op2, _op3 : tregister);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          ops:=3;
          loadconst(0,_op1);
          loadconst(0,_op1);
          loadreg(1,_op2);
          loadreg(1,_op2);
@@ -209,7 +298,7 @@ implementation
 
 
      constructor taicpu.op_const_reg_const(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : longint);
      constructor taicpu.op_const_reg_const(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : longint);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          ops:=3;
          loadconst(0,_op1);
          loadconst(0,_op1);
          loadreg(1,_op2);
          loadreg(1,_op2);
@@ -219,7 +308,7 @@ implementation
 
 
      constructor taicpu.op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister);
      constructor taicpu.op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=4;
          ops:=4;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadreg(1,_op2);
          loadreg(1,_op2);
@@ -229,7 +318,7 @@ implementation
 
 
      constructor taicpu.op_reg_bool_reg_reg(op : tasmop;_op1: tregister;_op2:boolean;_op3,_op4:tregister);
      constructor taicpu.op_reg_bool_reg_reg(op : tasmop;_op1: tregister;_op2:boolean;_op3,_op4:tregister);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=4;
          ops:=4;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadbool(1,_op2);
          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);
      constructor taicpu.op_reg_bool_reg_const(op : tasmop;_op1: tregister;_op2:boolean;_op3:tregister;_op4: longint);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=4;
          ops:=4;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadbool(0,_op2);
          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);
      constructor taicpu.op_reg_reg_const_const_const(op : tasmop;_op1,_op2 : tregister;_op3,_op4,_op5 : Longint);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=5;
          ops:=5;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadreg(1,_op2);
          loadreg(1,_op2);
@@ -258,17 +347,17 @@ implementation
          loadconst(4,_op5);
          loadconst(4,_op5);
       end;
       end;
 
 
-    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : pasmsymbol);
+    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          condition:=cond;
          condition:=cond;
          ops:=1;
          ops:=1;
          loadsymbol(0,_op1,0);
          loadsymbol(0,_op1,0);
       end;
       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
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=3;
          ops:=3;
          loadconst(0,_op1);
          loadconst(0,_op1);
          loadconst(1,_op2);
          loadconst(1,_op2);
@@ -276,54 +365,58 @@ implementation
       end;
       end;
 
 
 
 
-    constructor taicpu.op_sym(op : tasmop;_op1 : pasmsymbol);
+    constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
          ops:=1;
          loadsymbol(0,_op1,0);
          loadsymbol(0,_op1,0);
       end;
       end;
 
 
 
 
-    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint);
+    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
       begin
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=1;
          ops:=1;
          loadsymbol(0,_op1,_op1ofs);
          loadsymbol(0,_op1,_op1ofs);
       end;
       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
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          ops:=2;
          loadreg(0,_op1);
          loadreg(0,_op1);
          loadsymbol(1,_op2,_op2ofs);
          loadsymbol(1,_op2,_op2ofs);
       end;
       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
       begin
-         inherited init(op);
+         inherited create(op);
          ops:=2;
          ops:=2;
          loadsymbol(0,_op1,_op1ofs);
          loadsymbol(0,_op1,_op1ofs);
          loadref(1,_op2);
          loadref(1,_op2);
       end;
       end;
 
 
-    destructor taicpu.done;
+    destructor taicpu.destroy;
       var
       var
         i : longint;
         i : longint;
       begin
       begin
           for i:=ops-1 downto 0 do
           for i:=ops-1 downto 0 do
             if (oper[i].typ=top_ref) then
             if (oper[i].typ=top_ref) then
               dispose(oper[i].ref);
               dispose(oper[i].ref);
-        inherited done;
+        inherited destroy;
       end;
       end;
 
 
 end.
 end.
 {
 {
   $Log$
   $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
   Revision 1.5  2000/01/07 01:14:58  peter
     * updated copyright to 2000
     * updated copyright to 2000
@@ -342,5 +435,4 @@ end.
 
 
   Revision 1.1  1999/08/03 23:37:53  jonas
   Revision 1.1  1999/08/03 23:37:53  jonas
     + initial implementation for PowerPC based on the Alpha stuff
     + initial implementation for PowerPC based on the Alpha stuff
-
-}
+}

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

@@ -21,13 +21,13 @@
  ****************************************************************************
  ****************************************************************************
 }
 }
 unit cpubase;
 unit cpubase;
+
+{$i defines.inc}
+
 interface
 interface
-{$ifdef TP}
-  {$L-,Y-}
-{$endif}
 
 
 uses
 uses
-  strings,cobjects,aasm,cpuinfo;
+  strings,cutils,cclasses,aasm,cpuinfo;
 
 
 {$ifndef NOOPT}
 {$ifndef NOOPT}
 Type
 Type
@@ -117,16 +117,11 @@ type
 
 
   op2strtable=array[tasmop] of string[8];
   op2strtable=array[tasmop] of string[8];
 
 
-
-
 const
 const
-
   firstop = low(tasmop);
   firstop = low(tasmop);
   lastop  = high(tasmop);
   lastop  = high(tasmop);
 
 
 
 
-
-
 {*****************************************************************************
 {*****************************************************************************
                                   Registers
                                   Registers
 *****************************************************************************}
 *****************************************************************************}
@@ -202,6 +197,9 @@ Const
     'XER','LR','CTR','FPSCR'
     'XER','LR','CTR','FPSCR'
   );
   );
 
 
+  { FIX ME !!!!!!!!! }
+  ALL_REGISTERS = [R_0..R_FPSCR];
+
 
 
 {*****************************************************************************
 {*****************************************************************************
                                 Conditions
                                 Conditions
@@ -211,11 +209,11 @@ type
 {$ifndef tp}
 {$ifndef tp}
 {$minenumsize 1}
 {$minenumsize 1}
 {$endif tp}
 {$endif tp}
-  TAsmCondFlags = (CF_None { unconditional junps },
+  TAsmCondFlags = (C_None { unconditional junps },
     { conditions when not using ctr decrement etc }
     { 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 }
     { 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}
 {$ifndef tp}
 {$minenumsize default}
 {$minenumsize default}
@@ -225,13 +223,13 @@ type
                  false: (BO, BI: byte);
                  false: (BO, BI: byte);
                  true: (
                  true: (
                    case cond: TAsmCondFlags of
                    case cond: TAsmCondFlags of
-                     CF_None: ();
+                     C_None: ();
                      { specifies in which part of the cr the bit has to be }
                      { specifies in which part of the cr the bit has to be }
                      { tested for blt,bgt,beq etc.                         }
                      { 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. }
                      { 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)
                        (crbit: byte)
                    );
                    );
              end;
              end;
@@ -285,7 +283,7 @@ type
      is_immediate: boolean; { is this used as reference or immediate }
      is_immediate: boolean; { is this used as reference or immediate }
      base, index : tregister;
      base, index : tregister;
      offset      : longint;
      offset      : longint;
-     symbol      : pasmsymbol;
+     symbol      : tasmsymbol;
      symaddr     : trefsymaddr;
      symaddr     : trefsymaddr;
      offsetfixup : longint;
      offsetfixup : longint;
      options     : trefoptions;
      options     : trefoptions;
@@ -309,7 +307,7 @@ type
      top_reg    : (reg:tregister);
      top_reg    : (reg:tregister);
      top_ref    : (ref:preference);
      top_ref    : (ref:preference);
      top_const  : (val:aword);
      top_const  : (val:aword);
-     top_symbol : (sym:pasmsymbol;symofs:longint);
+     top_symbol : (sym:tasmsymbol;symofs:longint);
      top_bool  :  (b: boolean);
      top_bool  :  (b: boolean);
   end;
   end;
 
 
@@ -322,8 +320,8 @@ type
   TLoc=(
   TLoc=(
     LOC_INVALID,     { added for tracking problems}
     LOC_INVALID,     { added for tracking problems}
     LOC_REGISTER,    { in a processor register }
     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_CFPUREGISTER,{ Constant FPU register which shouldn't be modified }
     LOC_MMREGISTER,  { multimedia register }
     LOC_MMREGISTER,  { multimedia register }
     LOC_CMMREGISTER, { Constant multimedia reg which shouldn't be modified }
     LOC_CMMREGISTER, { Constant multimedia reg which shouldn't be modified }
@@ -337,7 +335,7 @@ type
   tlocation = packed record
   tlocation = packed record
      case loc : tloc of
      case loc : tloc of
         LOC_MEM,LOC_REFERENCE : (reference : treference);
         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 : (
           LOC_REGISTER,LOC_CREGISTER : (
             case longint of
             case longint of
               1 : (registerlow,registerhigh : tregister);
               1 : (registerlow,registerhigh : tregister);
@@ -405,6 +403,12 @@ const
   max_scratch_regs = 3;
   max_scratch_regs = 3;
   scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_11,R_12,R_30);
   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 }
 { low and high of the available maximum width integer general purpose }
 { registers                                                           }
 { registers                                                           }
   LoGPReg = R_0;
   LoGPReg = R_0;
@@ -451,6 +455,10 @@ const
     procedure create_cond_imm(BO,BI:byte;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 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
                                   Init/Done
 *****************************************************************************}
 *****************************************************************************}
@@ -520,9 +528,9 @@ implementation
 
 
     procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
     procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
     const
     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
     begin
       c.cond := inv_condflags[c.cond];
       c.cond := inv_condflags[c.cond];
       r := c;
       r := c;
@@ -545,13 +553,37 @@ implementation
       c.simple := true;
       c.simple := true;
       c.cond := cond;
       c.cond := cond;
       case cond of
       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];
         else c.cr := cr2reg[cr];
       end;
       end;
       r := c;
       r := c;
     end;
     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
                                   Init/Done
 *****************************************************************************}
 *****************************************************************************}
@@ -567,8 +599,12 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
   Revision 1.15  2000/05/01 11:04:49  jonas
     * changed NOT to A_NOP
     * changed NOT to A_NOP
@@ -606,7 +642,7 @@ end.
     * several changes to the way conditional branches are handled\n  * some typos fixed
     * several changes to the way conditional branches are handled\n  * some typos fixed
 
 
   Revision 1.5  1999/08/23 23:27:54  pierre
   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
   Revision 1.4  1999/08/06 16:41:12  jonas
     * PowerPC compiles again, several routines implemented in cgcpu.pas
     * PowerPC compiles again, several routines implemented in cgcpu.pas

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

@@ -2,7 +2,7 @@
     $Id$
     $Id$
     Copyright (c) 1998-2000 by the Free Pascal development team
     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,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
@@ -19,11 +19,22 @@ Interface
 
 
 Type
 Type
    { Architecture word - Native unsigned type }
    { Architecture word - Native unsigned type }
-{$ifdef FPC}
    AWord = Dword;
    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
 Const
    { Size of native extended type }
    { Size of native extended type }
@@ -31,4 +42,11 @@ Const
 
 
 Implementation
 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
+}