Browse Source

* powerpc64 port from Thomas Schatzl

git-svn-id: trunk@1193 -
peter 20 years ago
parent
commit
6bf3269b41
81 changed files with 13936 additions and 10 deletions
  1. 65 0
      .gitattributes
  2. 22 3
      compiler/cgbase.pas
  3. 8 0
      compiler/compiler.pas
  4. 7 0
      compiler/fpcdefs.inc
  5. 8 0
      compiler/globals.pas
  6. 10 0
      compiler/options.pas
  7. 412 0
      compiler/powerpc64/aasmcpu.pas
  8. 364 0
      compiler/powerpc64/agppcgas.pas
  9. 41 0
      compiler/powerpc64/aoptcpu.pas
  10. 123 0
      compiler/powerpc64/aoptcpub.pas
  11. 40 0
      compiler/powerpc64/aoptcpuc.pas
  12. 40 0
      compiler/powerpc64/aoptcpud.pas
  13. 1626 0
      compiler/powerpc64/cgcpu.pas
  14. 541 0
      compiler/powerpc64/cpubase.pas
  15. 69 0
      compiler/powerpc64/cpuinfo.pas
  16. 51 0
      compiler/powerpc64/cpunode.pas
  17. 576 0
      compiler/powerpc64/cpupara.pas
  18. 109 0
      compiler/powerpc64/cpupi.pas
  19. 125 0
      compiler/powerpc64/cpuswtch.pas
  20. 67 0
      compiler/powerpc64/cputarg.pas
  21. 158 0
      compiler/powerpc64/itcpugas.pas
  22. 851 0
      compiler/powerpc64/nppcadd.pas
  23. 55 0
      compiler/powerpc64/nppccal.pas
  24. 309 0
      compiler/powerpc64/nppccnv.pas
  25. 148 0
      compiler/powerpc64/nppcinl.pas
  26. 62 0
      compiler/powerpc64/nppcld.pas
  27. 373 0
      compiler/powerpc64/nppcmat.pas
  28. 149 0
      compiler/powerpc64/nppcset.pas
  29. 75 0
      compiler/powerpc64/ppcins.dat
  30. 143 0
      compiler/powerpc64/ppcreg.dat
  31. 42 0
      compiler/powerpc64/rappc.pas
  32. 730 0
      compiler/powerpc64/rappcgas.pas
  33. 46 0
      compiler/powerpc64/rgcpu.pas
  34. 111 0
      compiler/powerpc64/rppccon.inc
  35. 111 0
      compiler/powerpc64/rppcdwrf.inc
  36. 111 0
      compiler/powerpc64/rppcgas.inc
  37. 111 0
      compiler/powerpc64/rppcgri.inc
  38. 111 0
      compiler/powerpc64/rppcgss.inc
  39. 111 0
      compiler/powerpc64/rppcmot.inc
  40. 111 0
      compiler/powerpc64/rppcmri.inc
  41. 2 0
      compiler/powerpc64/rppcnor.inc
  42. 111 0
      compiler/powerpc64/rppcnum.inc
  43. 111 0
      compiler/powerpc64/rppcrni.inc
  44. 111 0
      compiler/powerpc64/rppcsri.inc
  45. 111 0
      compiler/powerpc64/rppcstab.inc
  46. 111 0
      compiler/powerpc64/rppcstd.inc
  47. 111 0
      compiler/powerpc64/rppcsup.inc
  48. 7 0
      compiler/pp.pas
  49. 6 0
      compiler/psystem.pas
  50. 13 0
      compiler/raatt.pas
  51. 3 0
      compiler/rautils.pas
  52. 3 0
      compiler/symdef.pas
  53. 12 3
      compiler/systems.pas
  54. 70 2
      compiler/systems/i_linux.pas
  55. 12 0
      compiler/systems/t_linux.pas
  56. 4 0
      compiler/tgobj.pas
  57. 5 2
      compiler/version.pas
  58. 30 0
      rtl/linux/powerpc64/bsyscall.inc
  59. 282 0
      rtl/linux/powerpc64/cprt0.as
  60. 8 0
      rtl/linux/powerpc64/dllprt0.as
  61. 10 0
      rtl/linux/powerpc64/gprt0.as
  62. 258 0
      rtl/linux/powerpc64/prt0.as
  63. 104 0
      rtl/linux/powerpc64/sighnd.inc
  64. 158 0
      rtl/linux/powerpc64/sighndh.inc
  65. 74 0
      rtl/linux/powerpc64/stat.inc
  66. 742 0
      rtl/linux/powerpc64/syscall.inc
  67. 86 0
      rtl/linux/powerpc64/syscallh.inc
  68. 522 0
      rtl/linux/powerpc64/sysnr.inc
  69. 18 0
      rtl/powerpc64/int64p.inc
  70. 310 0
      rtl/powerpc64/math.inc
  71. 13 0
      rtl/powerpc64/mathu.inc
  72. 14 0
      rtl/powerpc64/mathuh.inc
  73. 1071 0
      rtl/powerpc64/powerpc.inc
  74. 357 0
      rtl/powerpc64/set.inc
  75. 125 0
      rtl/powerpc64/setjump.inc
  76. 26 0
      rtl/powerpc64/setjumph.inc
  77. 503 0
      rtl/powerpc64/strings.inc
  78. 40 0
      rtl/powerpc64/stringss.inc
  79. 33 0
      rtl/powerpc64/strlen.inc
  80. 54 0
      rtl/powerpc64/strpas.inc
  81. 73 0
      rtl/powerpc64/sysutilp.inc

+ 65 - 0
.gitattributes

@@ -326,6 +326,47 @@ compiler/powerpc/rppcsri.inc svneol=native#text/plain
 compiler/powerpc/rppcstab.inc svneol=native#text/plain
 compiler/powerpc/rppcstab.inc svneol=native#text/plain
 compiler/powerpc/rppcstd.inc svneol=native#text/plain
 compiler/powerpc/rppcstd.inc svneol=native#text/plain
 compiler/powerpc/rppcsup.inc svneol=native#text/plain
 compiler/powerpc/rppcsup.inc svneol=native#text/plain
+compiler/powerpc64/aasmcpu.pas svneol=native#text/plain
+compiler/powerpc64/agppcgas.pas svneol=native#text/plain
+compiler/powerpc64/aoptcpu.pas svneol=native#text/plain
+compiler/powerpc64/aoptcpub.pas svneol=native#text/plain
+compiler/powerpc64/aoptcpuc.pas svneol=native#text/plain
+compiler/powerpc64/aoptcpud.pas svneol=native#text/plain
+compiler/powerpc64/cgcpu.pas svneol=native#text/plain
+compiler/powerpc64/cpubase.pas svneol=native#text/plain
+compiler/powerpc64/cpuinfo.pas svneol=native#text/plain
+compiler/powerpc64/cpunode.pas svneol=native#text/plain
+compiler/powerpc64/cpupara.pas svneol=native#text/plain
+compiler/powerpc64/cpupi.pas svneol=native#text/plain
+compiler/powerpc64/cpuswtch.pas svneol=native#text/plain
+compiler/powerpc64/cputarg.pas svneol=native#text/plain
+compiler/powerpc64/itcpugas.pas svneol=native#text/plain
+compiler/powerpc64/nppcadd.pas svneol=native#text/plain
+compiler/powerpc64/nppccal.pas svneol=native#text/plain
+compiler/powerpc64/nppccnv.pas svneol=native#text/plain
+compiler/powerpc64/nppcinl.pas svneol=native#text/plain
+compiler/powerpc64/nppcld.pas svneol=native#text/plain
+compiler/powerpc64/nppcmat.pas svneol=native#text/plain
+compiler/powerpc64/nppcset.pas svneol=native#text/plain
+compiler/powerpc64/ppcins.dat -text
+compiler/powerpc64/ppcreg.dat -text
+compiler/powerpc64/rappc.pas svneol=native#text/plain
+compiler/powerpc64/rappcgas.pas svneol=native#text/plain
+compiler/powerpc64/rgcpu.pas svneol=native#text/plain
+compiler/powerpc64/rppccon.inc svneol=native#text/plain
+compiler/powerpc64/rppcdwrf.inc svneol=native#text/plain
+compiler/powerpc64/rppcgas.inc svneol=native#text/plain
+compiler/powerpc64/rppcgri.inc svneol=native#text/plain
+compiler/powerpc64/rppcgss.inc svneol=native#text/plain
+compiler/powerpc64/rppcmot.inc svneol=native#text/plain
+compiler/powerpc64/rppcmri.inc svneol=native#text/plain
+compiler/powerpc64/rppcnor.inc svneol=native#text/plain
+compiler/powerpc64/rppcnum.inc svneol=native#text/plain
+compiler/powerpc64/rppcrni.inc svneol=native#text/plain
+compiler/powerpc64/rppcsri.inc svneol=native#text/plain
+compiler/powerpc64/rppcstab.inc svneol=native#text/plain
+compiler/powerpc64/rppcstd.inc svneol=native#text/plain
+compiler/powerpc64/rppcsup.inc svneol=native#text/plain
 compiler/pp.lpi -text
 compiler/pp.lpi -text
 compiler/pp.pas svneol=native#text/plain
 compiler/pp.pas svneol=native#text/plain
 compiler/ppc.cfg -text
 compiler/ppc.cfg -text
@@ -3605,6 +3646,17 @@ rtl/linux/powerpc/stat.inc svneol=native#text/plain
 rtl/linux/powerpc/syscall.inc svneol=native#text/plain
 rtl/linux/powerpc/syscall.inc svneol=native#text/plain
 rtl/linux/powerpc/syscallh.inc svneol=native#text/plain
 rtl/linux/powerpc/syscallh.inc svneol=native#text/plain
 rtl/linux/powerpc/sysnr.inc svneol=native#text/plain
 rtl/linux/powerpc/sysnr.inc svneol=native#text/plain
+rtl/linux/powerpc64/bsyscall.inc svneol=native#text/plain
+rtl/linux/powerpc64/cprt0.as -text
+rtl/linux/powerpc64/dllprt0.as -text
+rtl/linux/powerpc64/gprt0.as -text
+rtl/linux/powerpc64/prt0.as -text
+rtl/linux/powerpc64/sighnd.inc svneol=native#text/plain
+rtl/linux/powerpc64/sighndh.inc svneol=native#text/plain
+rtl/linux/powerpc64/stat.inc svneol=native#text/plain
+rtl/linux/powerpc64/syscall.inc svneol=native#text/plain
+rtl/linux/powerpc64/syscallh.inc svneol=native#text/plain
+rtl/linux/powerpc64/sysnr.inc svneol=native#text/plain
 rtl/linux/pthread.inc svneol=native#text/plain
 rtl/linux/pthread.inc svneol=native#text/plain
 rtl/linux/ptypes.inc svneol=native#text/plain
 rtl/linux/ptypes.inc svneol=native#text/plain
 rtl/linux/signal.inc svneol=native#text/plain
 rtl/linux/signal.inc svneol=native#text/plain
@@ -4030,6 +4082,19 @@ rtl/powerpc/stringss.inc svneol=native#text/plain
 rtl/powerpc/strlen.inc svneol=native#text/plain
 rtl/powerpc/strlen.inc svneol=native#text/plain
 rtl/powerpc/strpas.inc svneol=native#text/plain
 rtl/powerpc/strpas.inc svneol=native#text/plain
 rtl/powerpc/sysutilp.inc svneol=native#text/plain
 rtl/powerpc/sysutilp.inc svneol=native#text/plain
+rtl/powerpc64/int64p.inc svneol=native#text/plain
+rtl/powerpc64/math.inc svneol=native#text/plain
+rtl/powerpc64/mathu.inc svneol=native#text/plain
+rtl/powerpc64/mathuh.inc svneol=native#text/plain
+rtl/powerpc64/powerpc.inc svneol=native#text/plain
+rtl/powerpc64/set.inc svneol=native#text/plain
+rtl/powerpc64/setjump.inc svneol=native#text/plain
+rtl/powerpc64/setjumph.inc svneol=native#text/plain
+rtl/powerpc64/strings.inc svneol=native#text/plain
+rtl/powerpc64/stringss.inc svneol=native#text/plain
+rtl/powerpc64/strlen.inc svneol=native#text/plain
+rtl/powerpc64/strpas.inc svneol=native#text/plain
+rtl/powerpc64/sysutilp.inc svneol=native#text/plain
 rtl/solaris/Makefile svneol=native#text/plain
 rtl/solaris/Makefile svneol=native#text/plain
 rtl/solaris/Makefile.fpc svneol=native#text/plain
 rtl/solaris/Makefile.fpc svneol=native#text/plain
 rtl/solaris/errno.inc svneol=native#text/plain
 rtl/solaris/errno.inc svneol=native#text/plain

+ 22 - 3
compiler/cgbase.pas

@@ -53,9 +53,28 @@ interface
          LOC_CMMREGISTER
          LOC_CMMREGISTER
        );
        );
 
 
-       { 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                            }
-       trefaddr = (addr_no,addr_full,addr_hi,addr_lo,addr_pic);
+       { since we have only 16bit offsets, we need to be able to specify the high
+         and lower 16 bits of the address of a symbol of up to 64 bit }
+       trefaddr = (
+         addr_no,
+         addr_full,
+         {$IFNDEF POWERPC64}
+         addr_lo,
+         addr_hi,
+         {$ENDIF}
+         addr_pic
+         {$IFDEF POWERPC64}
+         ,
+         addr_low,         // bits 48-63
+         addr_high,        // bits 32-47
+         addr_higher,      // bits 16-31
+         addr_highest,     // bits 00-15
+         addr_higha,       // bits 16-31, adjusted
+         addr_highera,     // bits 32-47, adjusted
+         addr_highesta     // bits 48-63, adjusted
+         {$ENDIF}
+         );
+
 
 
        {# Generic opcodes, which must be supported by all processors
        {# Generic opcodes, which must be supported by all processors
        }
        }

+ 8 - 0
compiler/compiler.pas

@@ -64,6 +64,14 @@ unit compiler;
      {$fatal cannot define two CPU switches}
      {$fatal cannot define two CPU switches}
    {$endif}
    {$endif}
    {$endif}
    {$endif}
+   
+   {$ifdef POWERPC64}
+   {$ifndef CPUOK}
+   {$DEFINE CPUOK}
+   {$else}
+     {$fatal cannot define two CPU switches}
+   {$endif}
+   {$endif}   
 
 
    {$ifdef ia64}
    {$ifdef ia64}
    {$ifndef CPUOK}
    {$ifndef CPUOK}

+ 7 - 0
compiler/fpcdefs.inc

@@ -67,6 +67,13 @@
   {$define cpumm}
   {$define cpumm}
 {$endif powerpc}
 {$endif powerpc}
 
 
+{$ifdef powerpc64}
+  {$define cpu64bit}
+  {$define cpuflags}
+  {$define cputargethasfixedstack}
+  {$define cpumm}  
+{$endif powerpc64}
+
 {$ifdef arm}
 {$ifdef arm}
   {$define cpuflags}
   {$define cpuflags}
   {$define cpufpemu}
   {$define cpufpemu}

+ 8 - 0
compiler/globals.pas

@@ -2260,6 +2260,14 @@ end;
         {$ENDIF}
         {$ENDIF}
         initfputype:=fpu_standard;
         initfputype:=fpu_standard;
 {$endif powerpc}
 {$endif powerpc}
+{$ifdef POWERPC64}
+        initoptprocessor:=PPC970;
+        initpackenum:=4;
+        {$IFDEF testvarsets}
+         initsetalloc:=0;
+        {$ENDIF}
+        initfputype:=fpu_standard;
+{$endif POWERPC64}
 {$ifdef sparc}
 {$ifdef sparc}
         initoptprocessor:=SPARC_V8;
         initoptprocessor:=SPARC_V8;
         initpackenum:=4;
         initpackenum:=4;

+ 10 - 0
compiler/options.pas

@@ -1854,6 +1854,16 @@ begin
   def_system_macro('FPC_CURRENCY_IS_INT64');
   def_system_macro('FPC_CURRENCY_IS_INT64');
   def_system_macro('FPC_COMP_IS_INT64');
   def_system_macro('FPC_COMP_IS_INT64');
 {$endif}
 {$endif}
+{$ifdef POWERPC64}
+  def_system_macro('CPUPOWERPC');
+  def_system_macro('CPUPOWERPC64');
+  def_system_macro('CPU64');
+  def_system_macro('FPC_HAS_TYPE_DOUBLE');
+  def_system_macro('FPC_HAS_TYPE_SINGLE');
+  def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
+  def_system_macro('FPC_CURRENCY_IS_INT64');
+  def_system_macro('FPC_COMP_IS_INT64');
+{$endif}
 {$ifdef iA64}
 {$ifdef iA64}
   def_system_macro('CPUIA64');
   def_system_macro('CPUIA64');
   def_system_macro('CPU64');
   def_system_macro('CPU64');

+ 412 - 0
compiler/powerpc64/aasmcpu.pas

@@ -0,0 +1,412 @@
+{
+    Copyright (c) 1999-2002 by Jonas Maebe
+
+    Contains the assembler object for the PowerPC64. Heavily based on code
+    from the PowerPC platform
+
+    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 aasmcpu;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  globtype, verbose,
+  aasmbase, aasmtai,
+  cpubase, cgbase, cgutils;
+
+const
+  { "mov reg,reg" source operand number }
+  O_MOV_SOURCE = 1;
+  { "mov reg,reg" source operand number }
+  O_MOV_DEST = 0;
+
+type
+  taicpu = class(tai_cpu_abstract)
+    constructor op_none(op: tasmop);
+
+    constructor op_reg(op: tasmop; _op1: tregister);
+    constructor op_const(op: tasmop; _op1: aint);
+
+    constructor op_reg_reg(op: tasmop; _op1, _op2: tregister);
+    constructor op_reg_ref(op: tasmop; _op1: tregister; const _op2: treference);
+    constructor op_reg_const(op: tasmop; _op1: tregister; _op2: aint);
+    constructor op_const_reg(op: tasmop; _op1: aint; _op2: tregister);
+
+    constructor op_const_const(op: tasmop; _op1, _op2: aint);
+
+    constructor op_reg_reg_const_const(op: tasmop; _op1, _op2: tregister; _op3,
+      _op4: aint);
+
+    constructor op_reg_reg_reg(op: tasmop; _op1, _op2, _op3: tregister);
+    constructor op_reg_reg_const(op: tasmop; _op1, _op2: tregister; _op3: aint);
+    constructor op_reg_reg_sym_ofs(op: tasmop; _op1, _op2: tregister; _op3:
+      tasmsymbol; _op3ofs: aint);
+    constructor op_reg_reg_ref(op: tasmop; _op1, _op2: tregister; const _op3:
+      treference);
+    constructor op_const_reg_reg(op: tasmop; _op1: aint; _op2, _op3: tregister);
+    constructor op_const_reg_const(op: tasmop; _op1: aint; _op2: tregister;
+      _op3: aint);
+    constructor op_const_const_const(op: tasmop; _op1: aint; _op2: aint; _op3:
+      aint);
+
+    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: aint);
+
+    constructor op_reg_reg_reg_const_const(op: tasmop; _op1, _op2, _op3:
+      tregister; _op4, _op5: aint);
+    constructor op_reg_reg_const_const_const(op: tasmop; _op1, _op2: tregister;
+      _op3, _op4, _op5: aint);
+
+    { this is for Jmp instructions }
+    constructor op_cond_sym(op: tasmop; cond: TAsmCond; _op1: tasmsymbol);
+    constructor op_const_const_sym(op: tasmop; _op1, _op2: aint; _op3:
+      tasmsymbol);
+
+    constructor op_sym(op: tasmop; _op1: tasmsymbol);
+    constructor op_sym_ofs(op: tasmop; _op1: tasmsymbol; _op1ofs: aint);
+    constructor op_reg_sym_ofs(op: tasmop; _op1: tregister; _op2: tasmsymbol;
+      _op2ofs: aint);
+    constructor op_sym_ofs_ref(op: tasmop; _op1: tasmsymbol; _op1ofs: aint; const
+      _op2: treference);
+
+    procedure loadbool(opidx: aint; _b: boolean);
+
+    function is_same_reg_move(regtype: Tregistertype): boolean; override;
+
+  end;
+
+  tai_align = class(tai_align_abstract)
+    { nothing to add }
+  end;
+
+procedure InitAsm;
+procedure DoneAsm;
+
+function spilling_create_load(const ref: treference; r: tregister): tai;
+function spilling_create_store(r: tregister; const ref: treference): tai;
+
+implementation
+
+uses cutils;
+
+{*****************************************************************************
+                                 taicpu Constructors
+*****************************************************************************}
+
+procedure taicpu.loadbool(opidx: aint; _b: boolean);
+begin
+  if opidx >= ops then
+    ops := opidx + 1;
+  with oper[opidx]^ do
+  begin
+    if typ = top_ref then
+      dispose(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: aint);
+begin
+  inherited create(op);
+  ops := 1;
+  loadconst(0, _op1);
+end;
+
+constructor taicpu.op_reg_reg_const_const(op: tasmop; _op1, _op2: tregister;
+  _op3, _op4: aint);
+begin
+  inherited create(op);
+  ops := 4;
+  loadreg(0, _op1);
+  loadreg(1, _op2);
+  loadconst(2, _op3);
+  loadconst(3, _op4);
+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: aint);
+begin
+  inherited create(op);
+  ops := 2;
+  loadreg(0, _op1);
+  loadconst(1, _op2);
+end;
+
+constructor taicpu.op_const_reg(op: tasmop; _op1: aint; _op2: tregister);
+begin
+  inherited create(op);
+  ops := 2;
+  loadconst(0, _op1);
+  loadreg(1, _op2);
+end;
+
+constructor taicpu.op_reg_ref(op: tasmop; _op1: tregister; const _op2:
+  treference);
+begin
+  inherited create(op);
+  ops := 2;
+  loadreg(0, _op1);
+  loadref(1, _op2);
+end;
+
+constructor taicpu.op_const_const(op: tasmop; _op1, _op2: aint);
+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:
+  aint);
+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: aint);
+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; const _op3:
+  treference);
+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: aint; _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: aint; _op2: tregister;
+  _op3: aint);
+begin
+  inherited create(op);
+  ops := 3;
+  loadconst(0, _op1);
+  loadreg(1, _op2);
+  loadconst(2, _op3);
+end;
+
+constructor taicpu.op_const_const_const(op: tasmop; _op1: aint; _op2: aint;
+  _op3: aint);
+begin
+  inherited create(op);
+  ops := 3;
+  loadconst(0, _op1);
+  loadconst(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: aint);
+begin
+  inherited create(op);
+  ops := 4;
+  loadreg(0, _op1);
+  loadbool(0, _op2);
+  loadreg(0, _op3);
+  loadconst(0, cardinal(_op4));
+end;
+
+constructor taicpu.op_reg_reg_reg_const_const(op: tasmop; _op1, _op2, _op3:
+  tregister; _op4, _op5: aint);
+begin
+  inherited create(op);
+  ops := 5;
+  loadreg(0, _op1);
+  loadreg(1, _op2);
+  loadreg(2, _op3);
+  loadconst(3, cardinal(_op4));
+  loadconst(4, cardinal(_op5));
+end;
+
+constructor taicpu.op_reg_reg_const_const_const(op: tasmop; _op1, _op2:
+  tregister; _op3, _op4, _op5: aint);
+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: aint; _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: aint);
+begin
+  inherited create(op);
+  ops := 1;
+  loadsymbol(0, _op1, _op1ofs);
+end;
+
+constructor taicpu.op_reg_sym_ofs(op: tasmop; _op1: tregister; _op2: tasmsymbol;
+  _op2ofs: aint);
+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: aint;
+  const _op2: treference);
+begin
+  inherited create(op);
+  ops := 2;
+  loadsymbol(0, _op1, _op1ofs);
+  loadref(1, _op2);
+end;
+
+{ ****************************** newra stuff *************************** }
+
+function taicpu.is_same_reg_move(regtype: Tregistertype): boolean;
+begin
+  result :=
+    (((opcode = A_MR) and
+    (regtype = R_INTREGISTER)) or
+    ((opcode = A_FMR) and
+    (regtype = R_FPUREGISTER))) and
+    { these opcodes can only have registers as operands }
+  (oper[0]^.reg = oper[1]^.reg);
+end;
+
+function spilling_create_load(const ref: treference; r: tregister): tai;
+begin
+  result := taicpu.op_reg_ref(A_LD, r, ref);
+end;
+
+function spilling_create_store(r: tregister; const ref: treference): tai;
+begin
+  result := taicpu.op_reg_ref(A_STD, r, ref);
+end;
+
+procedure InitAsm;
+begin
+end;
+
+procedure DoneAsm;
+begin
+end;
+
+begin
+  cai_align := tai_align;
+  cai_cpu := taicpu;
+end.
+

+ 364 - 0
compiler/powerpc64/agppcgas.pas

@@ -0,0 +1,364 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit implements an asm for the PowerPC64. Heavily based on the one
+    from the PowerPC 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.
+
+ ****************************************************************************
+}
+{ This unit implements the GNU Assembler writer for the PowerPC
+}
+
+unit agppcgas;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  aasmtai,
+  aggas,
+  cpubase;
+
+type
+  PPPCGNUAssembler = ^TPPCGNUAssembler;
+  TPPCGNUAssembler = class(TGNUassembler)
+  public
+    procedure WriteExtraHeader; override;
+    procedure WriteInstruction(hp: tai); override;
+  end;
+
+implementation
+
+uses
+  cutils, globals, verbose,
+  cgbase, cgutils, systems,
+  assemble, globtype, fmodule,
+  itcpugas, finput,
+  aasmcpu;
+
+
+procedure TPPCGNUAssembler.WriteExtraHeader;
+var
+  i: longint;
+begin
+  for i := 0 to 31 do
+    AsmWriteln(#9'.set'#9'r' + tostr(i) + ',' + tostr(i));
+  for i := 0 to 31 do
+    AsmWriteln(#9'.set'#9'f' + tostr(i) + ',' + tostr(i));
+  AsmWriteLn('.macro FUNCTION_PROLOG fn');
+  AsmWriteLn('  .section    ".text"');
+  AsmWriteLn('  .align  2');
+  AsmWriteLn('  .globl  \fn');
+  AsmWriteLn('  .section    ".opd", "aw"');
+  AsmWriteLn('  .align  3');
+  AsmWriteLn('  \fn:');
+  AsmWriteLn('  .quad   .\fn, .TOC.@tocbase, 0');
+  AsmWriteLn('  .previous');
+  AsmWriteLn('  .size   \fn, 24');
+  AsmWriteLn('  .globl  .\fn');
+  AsmWriteLn('.\fn:');
+  AsmWriteLn('.endm');
+  AsmWriteLn('');
+  AsmWriteLn('.macro FUNCTION_EPILOG fn');
+  AsmWriteLn('  .long   0');
+  AsmWriteLn('  .byte   0, 12, 0, 0, 0, 0, 0, 0');
+  AsmWriteLn('  .type   .\fn, @function');
+  AsmWriteLn('  .size   .\fn,.-.\fn');
+  AsmWriteLn('.endm');
+  AsmWriteLn('');
+end;
+
+const
+  as_ppc_gas_info: tasminfo =
+  (
+    id: as_gas;
+
+    idtxt: 'AS';
+    asmbin: 'as';
+    asmcmd: '-a64 -o $OBJ $ASM';
+    supported_target: system_any;
+    flags: [af_allowdirect, af_needar, af_smartlink_sections];
+    labelprefix: '.L';
+    comment: '# ';
+    );
+
+  refaddr2str: array[trefaddr] of string[9] = ('', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
+
+function getreferencestring(var ref: treference): string;
+var
+  s: string;
+begin
+  with ref do
+  begin
+    if ((offset < -32768) or (offset > 32767)) and
+      (refaddr = addr_no) then
+      ; //internalerror(19991);
+    if (refaddr = addr_no) then
+      s := ''
+    else
+    begin
+      s := '(';
+      if assigned(symbol) then
+      begin
+        s := s + symbol.name;
+        if assigned(relsymbol) then
+          s := s + '-' + relsymbol.name;
+      end;
+    end;
+    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 (refaddr in [addr_low, addr_high, addr_higher, addr_highest, addr_higha, addr_highera, addr_highesta]) then
+    begin
+      s := s + ')';
+      if (target_info.system <> system_powerpc_darwin) then
+        s := s + refaddr2str[refaddr];
+    end;
+
+    if (index = NR_NO) and (base <> NR_NO) then
+    begin
+      if offset = 0 then
+      begin
+        if assigned(symbol) then
+        begin
+          if target_info.system <> system_powerpc_darwin then
+            s := s + '+0'
+        end
+        else
+          s := s + '0';
+      end;
+      s := s + '(' + gas_regname(base) + ')';
+    end
+    else if (index <> NR_NO) and (base <> NR_NO) then
+    begin
+      if (offset = 0) then
+        s := s + gas_regname(base) + ',' + gas_regname(index)
+      else
+        internalerror(19992);
+    end;
+  end;
+  getreferencestring := s;
+end;
+
+function getopstr_jmp(const o: toper): string;
+var
+  hs: string;
+begin
+  case o.typ of
+    top_reg:
+      getopstr_jmp := gas_regname(o.reg);
+    { no top_ref jumping for powerpc }
+    top_const:
+      getopstr_jmp := tostr(o.val);
+    top_ref:
+      begin
+        if o.ref^.refaddr <> addr_full then
+          internalerror(200402262);
+        hs := o.ref^.symbol.name;
+        if o.ref^.offset > 0 then
+          hs := hs + '+' + tostr(o.ref^.offset)
+        else if o.ref^.offset < 0 then
+          hs := hs + tostr(o.ref^.offset);
+        getopstr_jmp := hs;
+      end;
+    top_none:
+      getopstr_jmp := '';
+  else
+    internalerror(2002070603);
+  end;
+end;
+
+function getopstr(const o: toper): string;
+var
+  hs: string;
+begin
+  case o.typ of
+    top_reg:
+      getopstr := gas_regname(o.reg);
+    top_const:
+      getopstr := tostr(longint(o.val));
+    top_ref:
+      if o.ref^.refaddr = addr_full then
+      begin
+        hs := o.ref^.symbol.name;
+        if o.ref^.offset > 0 then
+          hs := hs + '+' + tostr(o.ref^.offset)
+        else if o.ref^.offset < 0 then
+          hs := hs + tostr(o.ref^.offset);
+        getopstr := hs;
+      end
+      else
+        getopstr := getreferencestring(o.ref^);
+  else
+    internalerror(2002070604);
+  end;
+end;
+
+function 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';
+  end;
+  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;
+
+function cond2str(op: tasmop; c: tasmcond): string;
+{ note: no checking is performed whether the given combination of }
+{ conditions is valid                                             }
+var
+  tempstr: string;
+begin
+  tempstr := #9;
+  case c.simple of
+    false:
+      begin
+        cond2str := tempstr + gas_op2str[op];
+        case c.dirhint of
+          DH_None: ;
+          DH_Minus:
+            cond2str := cond2str + '-';
+          DH_Plus:
+            cond2str := cond2str + '+';
+        else
+          internalerror(2003112901);
+        end;
+        cond2str := cond2str + #9 + tostr(c.bo) + ',' + tostr(c.bi);
+      end;
+    true:
+      if (op >= A_B) and (op <= A_BCLRL) then
+        case c.cond of
+          { unconditional branch }
+          C_NONE:
+            cond2str := tempstr + gas_op2str[op];
+          { bdnzt etc }
+        else
+          begin
+            tempstr := tempstr + 'b' + asmcondflag2str[c.cond] +
+              branchmode(op);
+            case c.dirhint of
+              DH_None:
+                tempstr := tempstr + #9;
+              DH_Minus:
+                tempstr := tempstr + ('-' + #9);
+              DH_Plus:
+                tempstr := tempstr + ('+' + #9);
+            else
+              internalerror(2003112901);
+            end;
+            case c.cond of
+              C_LT..C_NU:
+                cond2str := tempstr + gas_regname(newreg(R_SPECIALREGISTER,
+                  c.cr, R_SUBWHOLE));
+              C_T, C_F, C_DNZT, C_DNZF, C_DZT, C_DZF:
+                cond2str := tempstr + tostr(c.crbit);
+            else
+              cond2str := tempstr;
+            end;
+          end;
+        end
+          { we have a trap instruction }
+      else
+      begin
+        internalerror(2002070601);
+        { not yet implemented !!!!!!!!!!!!!!!!!!!!! }
+        { case tempstr := 'tw';}
+      end;
+  end;
+end;
+
+procedure TPPCGNUAssembler.WriteInstruction(hp: tai);
+var
+  op: TAsmOp;
+  s: string;
+  i: byte;
+  sep: string[3];
+begin
+  op := taicpu(hp).opcode;
+  if is_calljmp(op) then
+  begin
+    { direct BO/BI in op[0] and op[1] not supported, put them in condition! }
+    case op of
+      A_BL :
+        s := #9 + gas_op2str[op] + #9;
+      A_B, A_BA, A_BLA:
+        s := #9 + gas_op2str[op] + #9;
+      A_BCTR, A_BCTRL, A_BLR, A_BLRL:
+        s := #9 + gas_op2str[op]
+    else
+      begin
+        s := cond2str(op, taicpu(hp).condition);
+        if (s[length(s)] <> #9) and
+        (taicpu(hp).ops > 0) then
+          s := s + ',';
+      end;
+    end;
+
+    if (taicpu(hp).ops > 0) and (taicpu(hp).oper[0]^.typ <> top_none) then
+    begin
+      { first write the current contents of s, because the symbol }
+      { may be 255 characters                                     }
+      asmwrite(s);
+      s := getopstr_jmp(taicpu(hp).oper[0]^);
+    end;
+  end
+  else
+    { process operands }
+  begin
+    s := #9 + gas_op2str[op];
+    if taicpu(hp).ops <> 0 then
+    begin
+      {
+        if not is_calljmp(op) then
+          sep:=','
+        else
+      }
+      sep := #9;
+      for i := 0 to taicpu(hp).ops - 1 do
+      begin
+        // debug code
+        // writeln(s);
+        // writeln(taicpu(hp).fileinfo.line);
+        s := s + sep + getopstr(taicpu(hp).oper[i]^);
+        sep := ',';
+      end;
+    end;
+  end;
+  AsmWriteLn(s);
+end;
+
+
+begin
+  RegisterAssembler(as_ppc_gas_info, TPPCGNUAssembler);
+end.

+ 41 - 0
compiler/powerpc64/aoptcpu.pas

@@ -0,0 +1,41 @@
+{
+    Copyright (c) 1998-2002 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
+
+{$I fpcdefs.inc}
+
+uses cpubase, aoptobj, aoptcpub, aopt;
+
+type
+  TCpuAsmOptimizer = class(TAsmOptimizer)
+    { uses the same constructor as TAopObj }
+  end;
+
+implementation
+
+begin
+  casmoptimizer := TCpuAsmOptimizer;
+end.

+ 123 - 0
compiler/powerpc64/aoptcpub.pas

@@ -0,0 +1,123 @@
+{
+   Copyright (c) 1998-2002 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 PowerPC64 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 }
+
+{$I fpcdefs.inc}
+
+{ 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
+  aasmcpu, AOptBase, cpubase;
+
+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 = class(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 = 5;
+
+  {Oper index of operand that contains the source (reference) with a load }
+  {instruction                                                            }
+
+  LoadSrc = 1;
+
+  {Oper index of operand that contains the destination (register) with a load }
+  {instruction                                                                }
+
+  LoadDst = 0;
+
+  {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;
+
+  aopt_uncondjmp = A_B;
+  aopt_condjmp = A_BC;
+
+implementation
+
+{ ************************************************************************* }
+{ **************************** TCondRegs ********************************** }
+{ ************************************************************************* }
+
+constructor TCondRegs.init;
+begin
+end;
+
+destructor TCondRegs.Done;
+{$IFDEF inl}inline;
+{$ENDIF inl}
+begin
+end;
+
+end.
+

+ 40 - 0
compiler/powerpc64/aoptcpuc.pas

@@ -0,0 +1,40 @@
+{
+   Copyright (c) 1998-2002 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
+
+{$I fpcdefs.inc}
+
+uses
+  AOptCs;
+
+type
+  TRegInfoCpu = object(TRegInfo)
+  end;
+
+implementation
+
+end.
+

+ 40 - 0
compiler/powerpc64/aoptcpud.pas

@@ -0,0 +1,40 @@
+{
+    Copyright (c) 1998-2002 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;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  AOptDA;
+
+type
+  TAOptDFACpu = class(TAOptDFA)
+  end;
+
+implementation
+
+end.
+

+ 1626 - 0
compiler/powerpc64/cgcpu.pas

@@ -0,0 +1,1626 @@
+{
+    Copyright (c) 1998-2002 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;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  globtype, symtype, symdef,
+  cgbase, cgobj,
+  aasmbase, aasmcpu, aasmtai,
+  cpubase, cpuinfo, cgutils, rgcpu,
+  parabase;
+
+type
+  tcgppc = class(tcg)
+    procedure init_register_allocators; override;
+    procedure done_register_allocators; override;
+
+    { 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_const(list: taasmoutput; size: tcgsize; a: aint; const
+      paraloc: tcgpara); override;
+    procedure a_param_ref(list: taasmoutput; size: tcgsize; const r: treference;
+      const paraloc: tcgpara); override;
+    procedure a_paramaddr_ref(list: taasmoutput; const r: treference; const
+      paraloc: tcgpara); override;
+
+    procedure a_call_name(list: taasmoutput; const s: string); override;
+        procedure a_call_name_direct(list: taasmoutput; s: string; prependDot : boolean);
+
+    procedure a_call_reg(list: taasmoutput; reg: tregister); override;
+
+    procedure a_op_const_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; a:
+      aint; reg: TRegister); override;
+    procedure a_op_reg_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; src,
+      dst: TRegister); override;
+
+    procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+      size: tcgsize; a: aint; src, dst: tregister); override;
+    procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+      size: tcgsize; src1, src2, dst: tregister); override;
+
+    { move instructions }
+    procedure a_load_const_reg(list: taasmoutput; size: tcgsize; a: aint; reg:
+      tregister); override;
+    procedure a_load_reg_ref(list: taasmoutput; fromsize, tosize: tcgsize; reg:
+      tregister; const ref: treference); override;
+    procedure a_load_ref_reg(list: taasmoutput; fromsize, tosize: tcgsize; const
+      Ref: treference; reg: tregister); override;
+    procedure a_load_reg_reg(list: taasmoutput; fromsize, tosize: tcgsize; reg1,
+      reg2: tregister); override;
+
+    { fpu move instructions }
+    procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2:
+      tregister); override;
+    procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref:
+      treference; reg: tregister); override;
+    procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg:
+      tregister; const ref: treference); override;
+
+    {  comparison operations }
+    procedure a_cmp_const_reg_label(list: taasmoutput; size: tcgsize; cmp_op:
+      topcmp; a: aint; reg: tregister;
+      l: tasmlabel); override;
+    procedure a_cmp_reg_reg_label(list: taasmoutput; size: tcgsize; cmp_op:
+      topcmp; reg1, reg2: tregister; l: tasmlabel); override;
+
+    procedure a_jmp_name(list: taasmoutput; const s: string); override;
+    procedure a_jmp_always(list: taasmoutput; l: tasmlabel); override;
+    procedure a_jmp_flags(list: taasmoutput; const f: TResFlags; l: tasmlabel);
+      override;
+
+    procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags;
+      reg: TRegister); override;
+
+    procedure g_proc_entry(list: taasmoutput; localsize: longint; nostackframe:
+      boolean); override;
+    procedure g_proc_exit(list: taasmoutput; parasize: longint; nostackframe:
+      boolean); override;
+    procedure g_save_standard_registers(list: Taasmoutput); override;
+    procedure g_restore_standard_registers(list: Taasmoutput); override;
+
+    procedure a_loadaddr_ref_reg(list: taasmoutput; const ref: treference; r:
+      tregister); override;
+
+    procedure g_concatcopy(list: taasmoutput; const source, dest: treference;
+      len: aint); override;
+
+    procedure g_overflowcheck(list: taasmoutput; const l: tlocation; def: tdef);
+      override;
+    procedure a_jmp_cond(list: taasmoutput; cond: TOpCmp; l: tasmlabel);
+
+    procedure g_intf_wrapper(list: TAAsmoutput; procdef: tprocdef; const
+      labelname: string; ioffset: longint); override;
+
+  private
+
+    { Make sure ref is a valid reference for the PowerPC and sets the }
+    { base to the value of the index if (base = R_NO).                }
+    { Returns true if the reference contained a base, index and an    }
+    { offset or symbol, in which case the base will have been changed }
+    { to a tempreg (which has to be freed by the caller) containing   }
+    { the sum of part of the original reference                       }
+    function fixref(list: taasmoutput; var ref: treference): boolean;
+
+    { returns whether a reference can be used immediately in a powerpc }
+    { instruction                                                      }
+    function issimpleref(const ref: treference): boolean;
+
+    { contains the common code of a_load_reg_ref and a_load_ref_reg }
+    procedure a_load_store(list: taasmoutput; op: tasmop; reg: tregister;
+      ref: treference);
+
+    { creates the correct branch instruction for a given combination }
+    { of asmcondflags and destination addressing mode                }
+    procedure a_jmp(list: taasmoutput; op: tasmop;
+      c: tasmcondflag; crval: longint; l: tasmlabel);
+  end;
+
+const
+  TOpCG2AsmOpConstLo: array[topcg] of TAsmOp = (A_NONE, 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);
+  TOpCG2AsmOpConstHi: array[topcg] of TAsmOp = (A_NONE, 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);
+
+  TShiftOpCG2AsmOpConst32 : array[OP_SAR..OP_SHR] of TAsmOp = (A_SRAWI, A_SLWI, A_SRWI);
+  TShiftOpCG2AsmOpConst64 : array[OP_SAR..OP_SHR] of TAsmOp = (A_SRADI, A_SLDI, A_SRDI);
+
+  TOpCmp2AsmCond: array[topcmp] of TAsmCondFlag = (C_NONE, C_EQ, C_GT,
+    C_LT, C_GE, C_LE, C_NE, C_LE, C_LT, C_GE, C_GT);
+
+implementation
+
+uses
+  sysutils,
+  globals, verbose, systems, cutils,
+  symconst, symsym, fmodule,
+  rgobj, tgobj, cpupi, procinfo, paramgr;
+
+procedure tcgppc.init_register_allocators;
+begin
+  inherited init_register_allocators;
+  rg[R_INTREGISTER] := trgcpu.create(R_INTREGISTER, R_SUBWHOLE,
+    [RS_R3, RS_R4, RS_R5, RS_R6, RS_R7, RS_R8,
+      RS_R9, RS_R10, RS_R11, RS_R12, RS_R31, RS_R30, RS_R29,
+      RS_R28, RS_R27, RS_R26, RS_R25, RS_R24, RS_R23, RS_R22,
+      RS_R21, RS_R20, RS_R19, RS_R18, RS_R17, RS_R16, RS_R15,
+      RS_R14, RS_R13], first_int_imreg, []);
+  rg[R_FPUREGISTER] := trgcpu.create(R_FPUREGISTER, R_SUBNONE,
+    [RS_F0, RS_F1, RS_F2, RS_F3, RS_F4, RS_F5, RS_F6, RS_F7, RS_F8, RS_F9,
+    RS_F10, RS_F11, RS_F12, RS_F13, RS_F31, RS_F30, RS_F29, RS_F28, RS_F27,
+      RS_F26, RS_F25, RS_F24, RS_F23, RS_F22, RS_F21, RS_F20, RS_F19, RS_F18,
+      RS_F17, RS_F16, RS_F15, RS_F14], first_fpu_imreg, []);
+{$WARNING FIX ME}
+  rg[R_MMREGISTER] := trgcpu.create(R_MMREGISTER, R_SUBNONE,
+    [RS_M0, RS_M1, RS_M2], first_mm_imreg, []);
+end;
+
+procedure tcgppc.done_register_allocators;
+begin
+  rg[R_INTREGISTER].free;
+  rg[R_FPUREGISTER].free;
+  rg[R_MMREGISTER].free;
+  inherited done_register_allocators;
+end;
+
+procedure tcgppc.a_param_const(list: taasmoutput; size: tcgsize; a: aint; const
+  paraloc: tcgpara);
+var
+  ref: treference;
+begin
+  paraloc.check_simple_location;
+  case paraloc.location^.loc of
+    LOC_REGISTER, LOC_CREGISTER:
+      a_load_const_reg(list, size, a, paraloc.location^.register);
+    LOC_REFERENCE:
+      begin
+        reference_reset(ref);
+        ref.base := paraloc.location^.reference.index;
+        ref.offset := paraloc.location^.reference.offset;
+        a_load_const_ref(list, size, a, ref);
+      end;
+  else
+    internalerror(2002081101);
+  end;
+end;
+
+procedure tcgppc.a_param_ref(list: taasmoutput; size: tcgsize; const r:
+  treference; const paraloc: tcgpara);
+
+var
+  tmpref, ref: treference;
+  location: pcgparalocation;
+  sizeleft: aint;
+
+begin
+  location := paraloc.location;
+  tmpref := r;
+  sizeleft := paraloc.intsize;
+  while assigned(location) do
+  begin
+    case location^.loc of
+      LOC_REGISTER, LOC_CREGISTER:
+        begin
+          a_load_ref_reg(list, location^.size, location^.size, tmpref,
+            location^.register);
+        end;
+      LOC_REFERENCE:
+        begin
+          reference_reset_base(ref, location^.reference.index,
+            location^.reference.offset);
+          g_concatcopy(list, tmpref, ref, sizeleft);
+          if assigned(location^.next) then
+            internalerror(2005010710);
+        end;
+      LOC_FPUREGISTER, LOC_CFPUREGISTER:
+        case location^.size of
+          OS_F32, OS_F64:
+            a_loadfpu_ref_reg(list, location^.size, tmpref, location^.register);
+        else
+          internalerror(2002072801);
+        end;
+      LOC_VOID:
+        begin
+          // nothing to do
+        end;
+    else
+      internalerror(2002081103);
+    end;
+    inc(tmpref.offset, tcgsize2size[location^.size]);
+    dec(sizeleft, tcgsize2size[location^.size]);
+    location := location^.next;
+  end;
+end;
+
+procedure tcgppc.a_paramaddr_ref(list: taasmoutput; const r: treference; const
+  paraloc: tcgpara);
+var
+  ref: treference;
+  tmpreg: tregister;
+
+begin
+  paraloc.check_simple_location;
+  case paraloc.location^.loc of
+    LOC_REGISTER, LOC_CREGISTER:
+      a_loadaddr_ref_reg(list, r, paraloc.location^.register);
+    LOC_REFERENCE:
+      begin
+        reference_reset(ref);
+        ref.base := paraloc.location^.reference.index;
+        ref.offset := paraloc.location^.reference.offset;
+        tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+        a_loadaddr_ref_reg(list, r, tmpreg);
+        a_load_reg_ref(list, OS_ADDR, OS_ADDR, tmpreg, ref);
+      end;
+  else
+    internalerror(2002080701);
+  end;
+end;
+
+{ calling a procedure by name }
+
+procedure tcgppc.a_call_name(list: taasmoutput; const s: string);
+begin
+        a_call_name_direct(list, s, true);
+end;
+
+procedure tcgppc.a_call_name_direct(list: taasmoutput; s: string; prependDot : boolean);
+begin
+  if (prependDot) then begin
+        s := '.' + s;
+  end;
+  list.concat(taicpu.op_sym(A_BL, objectlibrary.newasmsymbol(s, AB_EXTERNAL,
+    AT_FUNCTION)));
+  list.concat(taicpu.op_none(A_NOP));
+  {
+         the compiler does not properly set this flag anymore in pass 1, and
+         for now we only need it after pass 2 (I hope) (JM)
+           if not(pi_do_call in current_procinfo.flags) then
+             internalerror(2003060703);
+  }
+  include(current_procinfo.flags, pi_do_call);
+end;
+
+
+{ calling a procedure by address }
+
+procedure tcgppc.a_call_reg(list: taasmoutput; reg: tregister);
+
+var
+  tmpreg: tregister;
+  tmpref: treference;
+
+  gotref : treference;
+
+begin
+  tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+
+  reference_reset(tmpref);
+  tmpref.offset := 0;
+  tmpref.base := reg;
+  list.concat(taicpu.op_reg_ref(A_LD, tmpreg, tmpref));
+
+//  TODO: GOT change
+
+//  reference_reset(gotref);
+//  tmpref.offset := 40;
+//  tmpref.base := rg[R_INTREGISTER].getregister(list, NR_STACK_POINTER_REG);
+
+//  taicpu.op_load_reg_ref(list, OS_INT, OS_INT,
+  list.concat(taicpu.op_reg(A_MTCTR, tmpreg));
+
+
+  list.concat(taicpu.op_none(A_BCTRL));
+  //if target_info.system=system_powerpc_macos then
+  //  //NOP is not needed here.
+  //  list.concat(taicpu.op_none(A_NOP));
+  include(current_procinfo.flags, pi_do_call);
+end;
+
+{********************** load instructions ********************}
+
+procedure tcgppc.a_load_const_reg(list: taasmoutput; size: TCGSize; a: aint;
+  reg: TRegister);
+
+var
+  scratchreg : TRegister;
+
+  procedure load32bitconstant(list : taasmoutput; size : TCGSize; a : longint;
+    reg : TRegister);
+  var is_half_signed : boolean;
+  begin
+(*
+    // ts: test optimized code using LI/ADDIS
+
+    if (smallint(a) = 0) and ((a shr 16) <> 0) then begin
+      list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(a shr 16)));
+    end else begin
+      is_half_signed := smallint(a) < 0;
+      list.concat(taicpu.op_reg_const(A_LI, reg, smallint(a)));
+      if smallint((a shr 16) + ord(is_half_signed)) <> 0 then begin
+        list.concat(taicpu.op_reg_reg_const(A_ADDIS, reg, reg, smallint((a shr 16) + ord(is_half_signed))));
+      end;
+    end;
+*)
+    // only 16 bit constant? (-2^15 <= a <= +2^15-1)
+    if (a >= low(smallint)) and (a <= high(smallint)) then begin
+      list.concat(taicpu.op_reg_const(A_LI, reg, smallint(a)));
+    end else begin
+      { check if we have to start with LI or LIS, load as 32 bit constant }
+      if ((a and $FFFF) <> 0) then begin
+        list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(a shr 16)));
+        list.concat(taicpu.op_reg_reg_const(A_ORI, reg, reg, word(a)));
+
+      end else begin
+        list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(a shr 16)));
+      end;
+    end;
+
+  end;
+var
+  astring : string;
+
+begin
+  astring := 'a_load_const reg ' + inttostr(a) + ' ' + inttostr(tcgsize2size[size]);
+  list.concat(tai_comment.create(strpnew(astring)));
+  if not (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
+    internalerror(2002090902);
+  // load low 32 bit (as signed number)
+  load32bitconstant(list, size, lo(a), reg);
+
+  // load high 32 bit if needed :( (the second expression is optimization, to be enabled and tested later!)
+  if (size in [OS_64, OS_S64]) {and (hi(a) <> 0)} then begin
+    // allocate scratch reg (=R0 because it might be called at places where register
+    // allocation has already happened - either procedure entry/exit, and stack check
+    // code generation)
+    // Note: I hope this restriction can be lifted at some time
+
+    //scratchreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    // load high 32 bit
+    load32bitconstant(list, size, hi(a), NR_R0);
+    // combine both registers
+    list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, reg, NR_R0, 32, 0));
+  end;
+(*
+  // for 16/32 bit unsigned constants we need to make sure that the difference from this size to
+  // 32 bits is cleared (since we optimize loading them as signed 16 bit parts, but 32 bit ops are
+  // used for them.
+  // e.g. for 16 bit there's a problem if the (unsigned) constant is of the form
+  //   xx..xx xx..xx 00..00 1x..xx
+  // same problem as above for 32 bit: unsigned constants of the form
+  //   xx..xx xx..xx 00..00 1x..xx
+  // cause troubles. Signed are ok.
+  // for now, just clear the upper 48/32 bits (also because full 32 bit op usage isn't done yet)
+  if (size in [OS_16, OS_32]) {and (lo(a) < 0)} then begin
+    a_load_reg_reg(list, size, size, reg, reg);
+  end; *)
+  // need to clear MSB for unsigned 64 bit int because we did not load the upper
+  // 32 bit at all (second expression is optimization: enable and test later!)
+  // e.g. constants of the form 00..00 00..00 1x..xx xx..xx
+  if (size in [OS_64]) and (hi(a) = 0) then begin
+        list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, reg, reg, 0, 32));
+  end;
+end;
+
+procedure tcgppc.a_load_reg_ref(list: taasmoutput; fromsize, tosize: TCGSize;
+  reg: tregister; const ref: treference);
+
+const
+  StoreInstr: array[OS_8..OS_64, 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)),
+    ((A_STD, A_STDU), (A_STDX, A_STDUX))
+    );
+var
+  op: TAsmOp;
+  ref2: TReference;
+begin
+  ref2 := ref;
+  fixref(list, ref2);
+  if tosize in [OS_S8..OS_S64] then
+    { storing is the same for signed and unsigned values }
+    tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8)));
+  op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false];
+  a_load_store(list, op, reg, ref2);
+end;
+
+procedure tcgppc.a_load_ref_reg(list: taasmoutput; fromsize, tosize: tcgsize;
+  const ref: treference; reg: tregister);
+
+const
+  LoadInstr: array[OS_8..OS_S64, 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)),
+    ((A_LD, A_LDU), (A_LDX, A_LDUX)),
+    { 128bit stuff too }
+    ((A_NONE, A_NONE), (A_NONE, A_NONE)),
+    { there's no load-byte-with-sign-extend :( }
+    ((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)),
+    ((A_LHA, A_LHAU), (A_LHAX, A_LHAUX)),
+    { there's no load-word-arithmetic-indexed with update, simulate it in code :( }
+    ((A_LWA, A_LWAU), (A_LWAX, A_LWAUX)),
+    ((A_LD, A_LDU), (A_LDX, A_LDUX))
+    );
+var
+  op: tasmop;
+  ref2: treference;
+
+begin
+  { TODO: optimize/take into consideration fromsize/tosize. Will }
+  { probably only matter for OS_S8 loads though                  }
+  if not (fromsize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then
+    internalerror(2002090902);
+  ref2 := ref;
+  fixref(list, ref2);
+  { the caller is expected to have adjusted the reference already }
+  { in this case                                                  }
+  if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then
+    fromsize := tosize;
+  op := loadinstr[fromsize, ref2.index <> NR_NO, false];
+  // there is no LWAU instruction, simulate using ADDI and LWA
+  if (op = A_LWAU) then begin
+        list.concat(taicpu.op_reg_reg_const(A_ADDI, reg, reg, ref2.offset));
+        ref2.offset := 0;
+        op := A_LWA;
+  end;
+  a_load_store(list, op, reg, ref2);
+  // sign extend shortint if necessary, since there is no
+  // load instruction that does that automatically (JM)
+  if fromsize = OS_S8 then
+    list.concat(taicpu.op_reg_reg(A_EXTSB, reg, reg));
+end;
+
+procedure tcgppc.a_load_reg_reg(list: taasmoutput; fromsize, tosize: tcgsize;
+  reg1, reg2: tregister);
+
+const
+  movemap : array[OS_8..OS_S128, OS_8..OS_S128] of tasmop = (
+{     to  -> OS_8      OS_16     OS_32     OS_64     OS_128    OS_S8     OS_S16    OS_S32    OS_S64    OS_S128 }
+{ from }
+{ OS_8    } (A_MR,     A_RLDICL, A_RLDICL, A_RLDICL, A_NONE,   A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP   ),
+{ OS_16   } (A_RLDICL, A_MR,     A_RLDICL, A_RLDICL, A_NONE,   A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP   ),
+{ OS_32   } (A_RLDICL, A_RLDICL, A_MR,     A_RLDICL, A_NONE,   A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP   ),
+{ OS_64   } (A_RLDICL, A_RLDICL, A_RLDICL, A_MR,     A_NONE,   A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP   ),
+{ OS_128  } (A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NOP   ),
+{ OS_S8   } (A_EXTSB,  A_EXTSB,  A_EXTSB,  A_EXTSB,  A_NONE,   A_MR,     A_EXTSB,  A_EXTSB,  A_EXTSB,  A_NOP   ),
+{ OS_S16  } (A_RLDICL, A_EXTSH,  A_EXTSH,  A_EXTSH,  A_NONE,   A_EXTSB,  A_MR,     A_EXTSH,  A_EXTSH,  A_NOP   ),
+{ OS_S32  } (A_RLDICL, A_RLDICL, A_EXTSW,  A_EXTSW,  A_NONE,   A_EXTSB,  A_EXTSH,  A_MR,     A_EXTSW,  A_NOP   ),
+{ OS_S64  } (A_RLDICL, A_RLDICL, A_RLDICL, A_MR,     A_NONE,   A_EXTSB,  A_EXTSH,  A_EXTSW,  A_MR,     A_NOP   ),
+{ OS_S128 } (A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NONE,   A_NOP   )
+);
+
+var
+  instr: taicpu;
+  op : tasmop;
+begin
+  op := movemap[fromsize, tosize];
+  case op of
+        A_MR, A_EXTSB, A_EXTSH, A_EXTSW : instr := taicpu.op_reg_reg(op, reg2, reg1);
+        A_RLDICL : instr := taicpu.op_reg_reg_const_const(A_RLDICL, reg2, reg1, 0, (8-tcgsize2size[fromsize])*8);
+  else
+    internalerror(2002090901);
+  end;
+  list.concat(instr);
+  rg[R_INTREGISTER].add_move_instruction(instr);
+end;
+
+procedure tcgppc.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2:
+  tregister);
+var
+  instr: taicpu;
+begin
+  instr := taicpu.op_reg_reg(A_FMR, reg2, reg1);
+  list.concat(instr);
+  rg[R_FPUREGISTER].add_move_instruction(instr);
+end;
+
+procedure tcgppc.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref:
+  treference; reg: tregister);
+const
+  FpuLoadInstr: array[OS_F32..OS_F64, boolean, boolean] of TAsmOp =
+  { indexed? updating?}
+  (((A_LFS, A_LFSU), (A_LFSX, A_LFSUX)),
+   ((A_LFD, A_LFDU), (A_LFDX, A_LFDUX)));
+var
+  op: tasmop;
+  ref2: treference;
+
+begin
+  { several functions call this procedure with OS_32 or OS_64 }
+  { so this makes life easier (FK)                            }
+  case size of
+    OS_32, OS_F32:
+      size := OS_F32;
+    OS_64, OS_F64, OS_C64:
+      size := OS_F64;
+  else
+    internalerror(200201121);
+  end;
+  ref2 := ref;
+  fixref(list, ref2);
+  op := fpuloadinstr[size, ref2.index <> NR_NO, false];
+  a_load_store(list, op, reg, ref2);
+end;
+
+procedure tcgppc.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg:
+  tregister; const ref: treference);
+
+const
+  FpuStoreInstr: array[OS_F32..OS_F64, boolean, boolean] of TAsmOp =
+  { indexed? updating?}
+  (((A_STFS, A_STFSU), (A_STFSX, A_STFSUX)),
+   ((A_STFD, A_STFDU), (A_STFDX, A_STFDUX)));
+var
+  op: tasmop;
+  ref2: treference;
+
+begin
+  if not (size in [OS_F32, OS_F64]) then
+    internalerror(200201122);
+  ref2 := ref;
+  fixref(list, ref2);
+  op := fpustoreinstr[size, ref2.index <> NR_NO, false];
+  a_load_store(list, op, reg, ref2);
+end;
+
+procedure tcgppc.a_op_const_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; a:
+  aint; reg: TRegister);
+begin
+  a_op_const_reg_reg(list, op, size, a, reg, reg);
+end;
+
+procedure tcgppc.a_op_reg_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; src,
+  dst: TRegister);
+begin
+  a_op_reg_reg_reg(list, op, size, src, dst, dst);
+end;
+
+procedure tcgppc.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
+  size: tcgsize; a: aint; src, dst: tregister);
+var
+  l1, l2: longint;
+  oplo, ophi: tasmop;
+  scratchreg: tregister;
+  useReg : boolean;
+  shiftmask : longint;
+
+  procedure do_lo_hi;
+  begin
+    usereg := false;
+    if (size in [OS_64, OS_S64]) then begin
+      // ts: use register method for 64 bit consts. Sloooooow
+      usereg := true;
+    end else if (size in [OS_32, OS_S32]) then begin
+      list.concat(taicpu.op_reg_reg_const(oplo, dst, src, word(a)));
+      list.concat(taicpu.op_reg_reg_const(ophi, dst, dst, word(a shr 16)));
+    end else begin
+      list.concat(taicpu.op_reg_reg_const(oplo, dst, src, word(a)));
+    end;
+  end;
+
+begin
+  if op = OP_SUB then begin
+    a_op_const_reg_reg(list, OP_ADD, size, -a, src, dst);
+    exit;
+  end;
+  ophi := TOpCG2AsmOpConstHi[op];
+  oplo := TOpCG2AsmOpConstLo[op];
+  // peephole optimizations for AND, OR, XOR - can't this be done at
+  // some higher level, independent of architecture?
+  if (op in [OP_AND, OP_OR, OP_XOR]) then begin
+    if (a = 0) then begin
+      if op = OP_AND then
+        list.concat(taicpu.op_reg_const(A_LI, dst, 0))
+      else
+        a_load_reg_reg(list, size, size, src, dst);
+      exit;
+    end else if (a = -1) then begin
+      case op of
+        OP_OR:
+          list.concat(taicpu.op_reg_const(A_LI, dst, -1));
+        OP_XOR:
+          list.concat(taicpu.op_reg_reg(A_NOT, dst, src));
+        OP_AND:
+          a_load_reg_reg(list, size, size, src, dst);
+      end;
+      exit;
+    end;
+  { optimization for add }
+  end else if (op = OP_ADD) then
+    if a = 0 then begin
+      a_load_reg_reg(list, size, size, src, dst);
+      exit;
+    end else if (a >= low(smallint)) and (a <= high(smallint)) then begin
+      list.concat(taicpu.op_reg_reg_const(A_ADDI, dst, src, smallint(a)));
+      exit;
+    end;
+
+  { otherwise, the instructions we can generate depend on the }
+  { operation                                                 }
+  useReg := false;
+  case op of
+    OP_DIV, OP_IDIV:
+      if (a = 0) then
+        internalerror(200208103)
+      else if (a = 1) then begin
+        a_load_reg_reg(list, OS_INT, OS_INT, src, dst);
+        exit
+      end else if false {and ispowerof2(a, l1)} then begin
+        internalerror(200208103);
+        case op of
+          OP_DIV: begin
+            list.concat(taicpu.op_reg_reg_const(A_SRDI, dst, src, l1));
+          end;
+          OP_IDIV:
+            begin
+              list.concat(taicpu.op_reg_reg_const(A_SRADI, dst, src, l1));
+              list.concat(taicpu.op_reg_reg(A_ADDZE, dst, dst));
+            end;
+        end;
+        exit;
+      end else
+        usereg := true;
+    OP_IMUL, OP_MUL:
+      if (a = 0) then begin
+        list.concat(taicpu.op_reg_const(A_LI, dst, 0));
+        exit
+      end else if (a = -1) then begin
+        list.concat(taicpu.op_reg_reg(A_NEG, dst, dst));
+      end else if (a = 1) then begin
+        a_load_reg_reg(list, OS_INT, OS_INT, src, dst);
+        exit
+      end else if ispowerof2(a, l1) then
+        list.concat(taicpu.op_reg_reg_const(A_SLDI, dst, src, l1))
+      else if (a >= low(smallint)) and (a <= high(smallint)) then
+        list.concat(taicpu.op_reg_reg_const(A_MULLI, dst, src,
+          smallint(a)))
+      else
+        usereg := true;
+    OP_ADD:
+      do_lo_hi;
+    OP_OR:
+      do_lo_hi;
+    OP_AND:
+      useReg := true;
+    OP_XOR:
+      do_lo_hi;
+    OP_SHL, OP_SHR, OP_SAR:
+      begin
+        {$note ts: cleanup todo, fix remaining bugs}
+        if (size in [OS_64, OS_S64]) then begin
+          if (a and 63) <> 0 then
+            list.concat(taicpu.op_reg_reg_const(
+              TShiftOpCG2AsmOpConst64[Op], dst, src, a and 63))
+          else
+            a_load_reg_reg(list, size, size, src, dst);
+          if (a shr 6) <> 0 then
+            internalError(68991);
+        end else begin
+          if (a and 31) <> 0 then
+            list.concat(taicpu.op_reg_reg_const(
+              TShiftOpCG2AsmOpConst32[Op], dst, src, a and 31))
+          else
+            a_load_reg_reg(list, size, size, src, dst);
+          if (a shr 5) <> 0 then
+            internalError(68991);
+        end;
+      end
+  else
+    internalerror(200109091);
+  end;
+  { if all else failed, load the constant in a register and then }
+  { perform the operation                                        }
+  if useReg then begin
+    scratchreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    a_load_const_reg(list, size, a, scratchreg);
+    a_op_reg_reg_reg(list, op, size, scratchreg, src, dst);
+  end;
+end;
+
+procedure tcgppc.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
+  size: tcgsize; src1, src2, dst: tregister);
+
+const
+  op_reg_reg_opcg2asmop32: array[TOpCG] of tasmop =
+  (A_NONE, A_ADD, A_AND, A_DIVWU, A_DIVW, A_MULLW, A_MULLW, A_NEG, A_NOT, A_OR,
+   A_SRAW, A_SLW, A_SRW, A_SUB, A_XOR);
+  op_reg_reg_opcg2asmop64: array[TOpCG] of tasmop =
+  (A_NONE, A_ADD, A_AND, A_DIVDU, A_DIVD, A_MULLD, A_MULLD, A_NEG, A_NOT, A_OR,
+   A_SRAD, A_SLD, A_SRD, A_SUB, A_XOR);
+
+begin
+  case op of
+    OP_NEG, OP_NOT:
+      begin
+        list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src1));
+        if (op = OP_NOT) and
+          not (size in [OS_64, OS_S64]) then
+          { zero/sign extend result again, fromsize is not important here }
+          a_load_reg_reg(list, OS_S64, size, dst, dst)
+      end;
+  else
+  {$NOTE ts:testme}
+    if (size in [OS_64, OS_S64]) then begin
+      list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src2,
+        src1));
+    end else begin
+      list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop32[op], dst, src2,
+        src1));
+    end;
+  end;
+end;
+
+{*************** compare instructructions ****************}
+
+procedure tcgppc.a_cmp_const_reg_label(list: taasmoutput; size: tcgsize; cmp_op:
+  topcmp; a: aint; reg: tregister;
+  l: tasmlabel);
+
+var
+  scratch_register: TRegister;
+  signed: boolean;
+
+begin
+  signed := cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE];
+  { in the following case, we generate more efficient code when }
+  { signed is true                                              }
+  if (cmp_op in [OC_EQ, OC_NE]) and
+    (aword(a) > $FFFF) then
+    signed := true;
+  if signed then
+    if (a >= low(smallint)) and (a <= high(smallint)) then
+      list.concat(taicpu.op_reg_reg_const(A_CMPDI, NR_CR0, reg, a))
+    else
+    begin
+      scratch_register := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+      a_load_const_reg(list, OS_64, a, scratch_register);
+      list.concat(taicpu.op_reg_reg_reg(A_CMPD, NR_CR0, reg, scratch_register));
+    end
+  else if (aword(a) <= $FFFF) then
+    list.concat(taicpu.op_reg_reg_const(A_CMPLDI, NR_CR0, reg, aword(a)))
+  else
+  begin
+    scratch_register := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    a_load_const_reg(list, OS_64, a, scratch_register);
+    list.concat(taicpu.op_reg_reg_reg(A_CMPLD, NR_CR0, reg,
+      scratch_register));
+  end;
+  a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l);
+end;
+
+procedure tcgppc.a_cmp_reg_reg_label(list: taasmoutput; size: tcgsize; cmp_op:
+  topcmp;
+  reg1, reg2: tregister; l: tasmlabel);
+
+var
+  op: tasmop;
+
+begin
+  if cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE] then
+    if (size in [OS_64, OS_S64]) then
+      op := A_CMPD
+    else
+      op := A_CMPW
+  else
+    if (size in [OS_64, OS_S64]) then
+      op := A_CMPLD
+    else
+      op := A_CMPLW;
+  list.concat(taicpu.op_reg_reg_reg(op, NR_CR0, reg2, reg1));
+  a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l);
+end;
+
+procedure tcgppc.a_jmp_cond(list: taasmoutput; cond: TOpCmp; l: tasmlabel);
+
+begin
+  a_jmp(list, A_BC, TOpCmp2AsmCond[cond], 0, l);
+end;
+
+procedure tcgppc.a_jmp_name(list: taasmoutput; const s: string);
+var
+  p: taicpu;
+begin
+  p := taicpu.op_sym(A_B, objectlibrary.newasmsymbol(s, AB_EXTERNAL,
+    AT_FUNCTION));
+  p.is_jmp := true;
+  list.concat(p)
+end;
+
+procedure tcgppc.a_jmp_always(list: taasmoutput; l: tasmlabel);
+
+begin
+  a_jmp(list, A_B, C_None, 0, l);
+end;
+
+procedure tcgppc.a_jmp_flags(list: taasmoutput; const f: TResFlags; l:
+  tasmlabel);
+
+var
+  c: tasmcond;
+begin
+  c := flags_to_cond(f);
+  a_jmp(list, A_BC, c.cond, c.cr - RS_CR0, l);
+end;
+
+procedure tcgppc.g_flags2reg(list: taasmoutput; size: TCgSize; const f:
+  TResFlags; reg: TRegister);
+
+var
+  testbit: byte;
+  bitvalue: boolean;
+
+begin
+  { get the bit to extract from the conditional register + its }
+  { requested value (0 or 1)                                   }
+  testbit := ((f.cr - RS_CR0) * 4);
+  case f.flag of
+    F_EQ, F_NE:
+      begin
+        inc(testbit, 2);
+        bitvalue := f.flag = F_EQ;
+      end;
+    F_LT, F_GE:
+      begin
+        bitvalue := f.flag = F_LT;
+      end;
+    F_GT, F_LE:
+      begin
+        inc(testbit);
+        bitvalue := f.flag = F_GT;
+      end;
+  else
+    internalerror(200112261);
+  end;
+  { load the conditional register in the destination reg }
+  list.concat(taicpu.op_reg(A_MFCR, reg));
+  { we will move the bit that has to be tested to bit 0 by rotating }
+  { left                                                            }
+  testbit := (testbit + 1) and 31;
+  { extract bit }
+  list.concat(taicpu.op_reg_reg_const_const_const(
+    A_RLWINM,reg,reg,testbit,31,31));
+
+  { if we need the inverse, xor with 1 }
+  if not bitvalue then
+    list.concat(taicpu.op_reg_reg_const(A_XORI, reg, reg, 1));
+end;
+
+{ *********** entry/exit code and address loading ************ }
+
+procedure tcgppc.g_save_standard_registers(list: Taasmoutput);
+begin
+  { this work is done in g_proc_entry }
+end;
+
+procedure tcgppc.g_restore_standard_registers(list: Taasmoutput);
+begin
+  { this work is done in g_proc_exit }
+end;
+
+procedure tcgppc.g_proc_entry(list: taasmoutput; localsize: longint;
+  nostackframe: boolean);
+{ 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.                                                                     }
+{ This procedure may be called before, as well as after g_return_from_proc }
+{ is called. NOTE registers are not to be allocated through the register   }
+{ allocator here, because the register colouring has already occured !!    }
+  procedure calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint);
+  var
+    reg : TSuperRegister;
+  begin
+    fprcount := 0;
+    firstfpr := RS_F31;
+    if not (po_assembler in current_procinfo.procdef.procoptions) then begin
+      for reg := RS_F14 to RS_F31 do begin
+        if reg in rg[R_FPUREGISTER].used_in_proc then begin
+          fprcount := ord(RS_F31)-ord(reg)+1;
+          firstfpr := reg;
+          break;
+        end;
+      end;
+    end;
+  end;
+
+  procedure calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint);
+  var
+    reg : TSuperRegister;
+  begin
+    gprcount := 0;
+    firstgpr := RS_R31;
+    if not (po_assembler in current_procinfo.procdef.procoptions) then begin
+      for reg := RS_R14 to RS_R31 do begin
+        if reg in rg[R_INTREGISTER].used_in_proc then begin
+          gprcount := ord(RS_R31)-ord(reg)+1;
+          firstgpr := reg;
+          break;
+        end;
+      end;
+    end;
+  end;
+
+var
+  firstregfpu, firstreggpr: TSuperRegister;
+  href: treference;
+  needslinkreg: boolean;
+  regcount : TSuperRegister;
+
+  fprcount, gprcount : aint;
+
+begin
+  { 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, NR_STACK_POINTER_REG);
+  a_reg_alloc(list, NR_R0);
+
+  calcFirstUsedFPR(firstregfpu, fprcount);
+  calcFirstUsedGPR(firstreggpr, gprcount);
+
+  // calculate real stack frame size
+  localsize := tppcprocinfo(current_procinfo).calc_stackframe_size(
+    gprcount, fprcount);
+
+  // determine whether we need to save the link register
+  needslinkreg := ((not (po_assembler in current_procinfo.procdef.procoptions)) and
+    (pi_do_call in current_procinfo.flags));
+
+  // move link register to r0
+  if (needslinkreg) then begin
+    list.concat(taicpu.op_reg(A_MFLR, NR_R0));
+  end;
+  // save old stack frame pointer
+  if (localsize > 0) then begin
+    a_reg_alloc(list, NR_R12);
+    list.concat(taicpu.op_reg_reg(A_MR, NR_R12, NR_STACK_POINTER_REG));
+  end;
+
+  // save registers, FPU first, then GPR
+  reference_reset_base(href, NR_STACK_POINTER_REG, -8);
+  if (fprcount > 0) then begin
+    for regcount := RS_F31 downto firstregfpu do begin
+      a_loadfpu_reg_ref(list, OS_FLOAT, newreg(R_FPUREGISTER, regcount,
+        R_SUBNONE), href);
+      dec(href.offset, tcgsize2size[OS_FLOAT]);
+    end;
+  end;
+  if (gprcount > 0) then begin
+    for regcount := RS_R31 downto firstreggpr do begin
+      a_load_reg_ref(list, OS_INT, OS_INT, newreg(R_INTREGISTER, regcount,
+        R_SUBNONE), href);
+      dec(href.offset, tcgsize2size[OS_INT]);
+    end;
+  end;
+
+  // VMX registers not supported by FPC atm
+
+  // we may need to store R0 (=LR) ourselves
+  if (needslinkreg) then begin
+    reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
+    list.concat(taicpu.op_reg_ref(A_STD, NR_R0, href));
+  end;
+
+  // create stack frame
+  if (not nostackframe) and (localsize > 0) then begin
+    if (localsize <= high(smallint)) then begin
+      reference_reset_base(href, NR_STACK_POINTER_REG, -localsize);
+      a_load_store(list, A_STDU, NR_STACK_POINTER_REG, href);
+    end else begin
+      writeln(localsize);
+      reference_reset_base(href, NR_NO, -localsize);
+
+      // use R0 for loading the constant (which is definitely > 32k when entering
+      // this branch)
+      // inlined because it must not use temp registers because register allocations
+      // have already been done :(
+      { Code template:
+      lis   r0,ofs@highest
+      ori   r0,r0,ofs@higher
+      sldi  r0,r0,32
+      oris  r0,r0,ofs@h
+      ori   r0,r0,ofs@l
+      }
+      list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48)));
+      list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32)));
+      list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32));
+      list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16)));
+      list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset)));
+
+      list.concat(taicpu.op_reg_reg_reg(A_STDUX, NR_R1, NR_R1, NR_R0));
+    end;
+  end;
+
+  // CR register not used by FPC atm
+
+  // keep R1 allocated???
+  a_reg_dealloc(list, NR_R0);
+end;
+
+procedure tcgppc.g_proc_exit(list: taasmoutput; parasize: longint; nostackframe:
+  boolean);
+
+  procedure calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint);
+  var
+    reg : TSuperRegister;
+  begin
+    fprcount := 0;
+    firstfpr := RS_F31;
+    if not (po_assembler in current_procinfo.procdef.procoptions) then begin
+      for reg := RS_F14 to RS_F31 do begin
+        if reg in rg[R_FPUREGISTER].used_in_proc then begin
+          fprcount := ord(RS_F31)-ord(reg)+1;
+          firstfpr := reg;
+          break;
+        end;
+      end;
+    end;
+  end;
+
+  procedure calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint);
+  var
+    reg : TSuperRegister;
+  begin
+    gprcount := 0;
+    firstgpr := RS_R31;
+    if not (po_assembler in current_procinfo.procdef.procoptions) then begin
+      for reg := RS_R14 to RS_R31 do begin
+        if reg in rg[R_INTREGISTER].used_in_proc then begin
+          gprcount := ord(RS_R31)-ord(reg)+1;
+          firstgpr := reg;
+          break;
+        end;
+      end;
+    end;
+  end;
+
+{ This procedure may be called before, as well as after g_stackframe_entry }
+{ is called. NOTE registers are not to be allocated through the register   }
+{ allocator here, because the register colouring has already occured !!    }
+
+var
+  regcount, firstregfpu, firstreggpr: TSuperRegister;
+  href: treference;
+  needslinkreg : boolean;
+  localsize,
+  fprcount, gprcount: aint;
+begin
+  calcFirstUsedFPR(firstregfpu, fprcount);
+  calcFirstUsedGPR(firstreggpr, gprcount);
+
+  // determine whether we need to restore the link register
+  needslinkreg := ((not (po_assembler in current_procinfo.procdef.procoptions)) and
+    (pi_do_call in current_procinfo.flags));
+  // calculate stack frame
+  localsize := tppcprocinfo(current_procinfo).calc_stackframe_size(
+    gprcount, fprcount);
+
+  // CR register not supported
+
+  // restore stack pointer
+  if (not nostackframe) and (localsize > 0) then begin
+    if (localsize <= high(smallint)) then begin
+      list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, localsize));
+    end else begin
+      reference_reset_base(href, NR_NO, localsize);
+
+      // use R0 for loading the constant (which is definitely > 32k when entering
+      // this branch)
+      // inlined because it must not use temp registers because register allocations
+      // have already been done :(
+      { Code template:
+      lis   r0,ofs@highest
+      ori   r0,ofs@higher
+      sldi  r0,r0,32
+      oris  r0,r0,ofs@h
+      ori   r0,r0,ofs@l
+      }
+      list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48)));
+      list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32)));
+      list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32));
+      list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16)));
+      list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset)));
+
+      list.concat(taicpu.op_reg_reg_reg(A_ADD, NR_R1, NR_R1, NR_R0));
+    end;
+  end;
+
+  // load registers, FPR first, then GPR
+  {$note ts:todo change order of loading}
+  reference_reset_base(href, NR_STACK_POINTER_REG, -tcgsize2size[OS_FLOAT]);
+  if (fprcount > 0) then begin
+    for regcount := RS_F31 downto firstregfpu do begin
+      a_loadfpu_ref_reg(list, OS_FLOAT, href, newreg(R_FPUREGISTER, regcount,
+        R_SUBNONE));
+      dec(href.offset, tcgsize2size[OS_FLOAT]);
+    end;
+  end;
+  if (gprcount > 0) then begin
+    for regcount := RS_R31 downto firstreggpr do begin
+      a_load_ref_reg(list, OS_INT, OS_INT, href, newreg(R_INTREGISTER, regcount,
+        R_SUBNONE));
+      dec(href.offset, tcgsize2size[OS_INT]);
+    end;
+  end;
+
+  // VMX not supported...
+
+  // restore LR (if needed)
+  if (needslinkreg) then begin
+    reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF);
+    list.concat(taicpu.op_reg_ref(A_LD, NR_R0, href));
+    list.concat(taicpu.op_reg(A_MTLR, NR_R0));
+  end;
+
+  // generate return instruction
+  list.concat(taicpu.op_none(A_BLR));
+end;
+
+
+procedure tcgppc.a_loadaddr_ref_reg(list: taasmoutput; const ref: treference; r:
+  tregister);
+
+var
+  ref2, tmpref: treference;
+  // register used to construct address
+  tempreg : TRegister;
+
+begin
+  ref2 := ref;
+  fixref(list, ref2);
+  { load a symbol }
+  if assigned(ref2.symbol) or (ref2.offset < low(smallint)) or (ref2.offset > high(smallint)) then begin
+      { add the symbol's value to the base of the reference, and if the }
+      { reference doesn't have a base, create one                       }
+      reference_reset(tmpref);
+      tmpref.offset := ref2.offset;
+      tmpref.symbol := ref2.symbol;
+      tmpref.relsymbol := ref2.relsymbol;
+      // load 64 bit reference into r. If the reference already has a base register,
+      // first load the 64 bit value into a temp register, then add it to the result
+      // register rD
+      if (ref2.base <> NR_NO) then begin
+        // already have a base register, so allocate a new one
+        tempreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+      end else begin
+        tempreg := r;
+      end;
+
+      // code for loading a reference from a symbol into a register rD.
+      (*
+      lis   rX,SYM@highest
+      ori   rX,SYM@higher
+      sldi  rX,rX,32
+      oris  rX,rX,SYM@h
+      ori   rX,rX,SYM@l
+      *)
+      tmpref.refaddr := addr_highest;
+      list.concat(taicpu.op_reg_ref(A_LIS, tempreg, tmpref));
+      tmpref.refaddr := addr_higher;
+      list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref));
+      list.concat(taicpu.op_reg_reg_const(A_SLDI, tempreg, tempreg, 32));
+      tmpref.refaddr := addr_high;
+      list.concat(taicpu.op_reg_reg_ref(A_ORIS, tempreg, tempreg, tmpref));
+      tmpref.refaddr := addr_low;
+      list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref));
+
+      // if there's already a base register, add the temp register contents to
+      // the base register
+      if (ref2.base <> NR_NO) then begin
+        list.concat(taicpu.op_reg_reg_reg(A_ADD, r, tempreg, ref2.base));
+      end;
+  end else if ref2.offset <> 0 then begin
+    { no symbol, but offset <> 0 }
+    if ref2.base <> NR_NO then begin
+      a_op_const_reg_reg(list, OP_ADD, OS_64, ref2.offset, ref2.base, r)
+      { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
+      { occurs, so now only ref.offset has to be loaded                         }
+    end else begin
+      a_load_const_reg(list, OS_64, ref2.offset, r)
+    end;
+  end else if ref.index <> NR_NO then
+    list.concat(taicpu.op_reg_reg_reg(A_ADD, r, ref2.base, ref2.index))
+  else if (ref2.base <> NR_NO) and
+    (r <> ref2.base) then
+    a_load_reg_reg(list, OS_ADDR, OS_ADDR, ref2.base, r)
+  else begin
+    list.concat(taicpu.op_reg_const(A_LI, r, 0));
+  end;
+end;
+
+{ ************* concatcopy ************ }
+
+const
+  maxmoveunit = 8;
+
+
+procedure tcgppc.g_concatcopy(list: taasmoutput; const source, dest: treference;
+  len: aint);
+
+var
+  countreg, tempreg: TRegister;
+  src, dst: TReference;
+  lab: tasmlabel;
+  count, count2: longint;
+  size: tcgsize;
+
+begin
+{$IFDEF extdebug}
+  if len > high(aint) then
+    internalerror(2002072704);
+{$ENDIF extdebug}
+  { make sure short loads are handled as optimally as possible }
+
+  if (len <= maxmoveunit) and
+    (byte(len) in [1, 2, 4, 8]) then
+  begin
+    if len < 8 then
+    begin
+      size := int_cgsize(len);
+      a_load_ref_ref(list, size, size, source, dest);
+    end
+    else
+    begin
+      a_reg_alloc(list, NR_F0);
+      a_loadfpu_ref_reg(list, OS_F64, source, NR_F0);
+      a_loadfpu_reg_ref(list, OS_F64, NR_F0, dest);
+      a_reg_dealloc(list, NR_F0);
+    end;
+    exit;
+  end;
+
+  count := len div maxmoveunit;
+
+  reference_reset(src);
+  reference_reset(dst);
+  { load the address of source into src.base }
+  if (count > 4) or
+    not issimpleref(source) or
+    ((source.index <> NR_NO) and
+    ((source.offset + len) > high(smallint))) then begin
+    src.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    a_loadaddr_ref_reg(list, source, src.base);
+  end else begin
+    src := source;
+  end;
+  { load the address of dest into dst.base }
+  if (count > 4) or
+    not issimpleref(dest) or
+    ((dest.index <> NR_NO) and
+    ((dest.offset + len) > high(smallint))) then begin
+    dst.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    a_loadaddr_ref_reg(list, dest, dst.base);
+  end else begin
+    dst := dest;
+  end;
+
+  { generate a loop }
+  if count > 4 then begin
+    { the offsets are zero after the a_loadaddress_ref_reg and just }
+    { have to be set to 8. 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 generated assembler                     }
+    inc(dst.offset, 8);
+    inc(src.offset, 8);
+    list.concat(taicpu.op_reg_reg_const(A_SUBI, src.base, src.base, 8));
+    list.concat(taicpu.op_reg_reg_const(A_SUBI, dst.base, dst.base, 8));
+    countreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+    a_load_const_reg(list, OS_32, count, countreg);
+    { explicitely allocate R_0 since it can be used safely here }
+    { (for holding date that's being copied)                    }
+    a_reg_alloc(list, NR_F0);
+    objectlibrary.getjumplabel(lab);
+    a_label(list, lab);
+    list.concat(taicpu.op_reg_reg_const(A_SUBIC_, countreg, countreg, 1));
+    list.concat(taicpu.op_reg_ref(A_LFDU, NR_F0, src));
+    list.concat(taicpu.op_reg_ref(A_STFDU, NR_F0, dst));
+    a_jmp(list, A_BC, C_NE, 0, lab);
+    a_reg_dealloc(list, NR_F0);
+    len := len mod 8;
+  end;
+
+  count := len div 8;
+  { unrolled loop }
+  if count > 0 then begin
+    a_reg_alloc(list, NR_F0);
+    for count2 := 1 to count do begin
+      a_loadfpu_ref_reg(list, OS_F64, src, NR_F0);
+      a_loadfpu_reg_ref(list, OS_F64, NR_F0, dst);
+      inc(src.offset, 8);
+      inc(dst.offset, 8);
+    end;
+    a_reg_dealloc(list, NR_F0);
+    len := len mod 8;
+  end;
+
+  if (len and 4) <> 0 then begin
+    a_reg_alloc(list, NR_R0);
+    a_load_ref_reg(list, OS_32, OS_32, src, NR_R0);
+    a_load_reg_ref(list, OS_32, OS_32, NR_R0, dst);
+    inc(src.offset, 4);
+    inc(dst.offset, 4);
+    a_reg_dealloc(list, NR_R0);
+  end;
+  { copy the leftovers }
+  if (len and 2) <> 0 then begin
+    a_reg_alloc(list, NR_R0);
+    a_load_ref_reg(list, OS_16, OS_16, src, NR_R0);
+    a_load_reg_ref(list, OS_16, OS_16, NR_R0, dst);
+    inc(src.offset, 2);
+    inc(dst.offset, 2);
+    a_reg_dealloc(list, NR_R0);
+  end;
+  if (len and 1) <> 0 then begin
+    a_reg_alloc(list, NR_R0);
+    a_load_ref_reg(list, OS_8, OS_8, src, NR_R0);
+    a_load_reg_ref(list, OS_8, OS_8, NR_R0, dst);
+    a_reg_dealloc(list, NR_R0);
+  end;
+
+end;
+
+procedure tcgppc.g_overflowcheck(list: taasmoutput; const l: tlocation; def:
+  tdef);
+var
+  hl: tasmlabel;
+  flags : TResFlags;
+begin
+  if not (cs_check_overflow in aktlocalswitches) then
+    exit;
+  objectlibrary.getjumplabel(hl);
+  if not ((def.deftype = pointerdef) or
+    ((def.deftype = orddef) and
+    (torddef(def).typ in [u64bit, u16bit, u32bit, u8bit, uchar,
+    bool8bit, bool16bit, bool32bit]))) then
+  begin
+    // ... instruction setting overflow flag ...
+    // mfxerf R0
+    // mtcrf 128, R0
+    // ble cr0, label
+    list.concat(taicpu.op_reg(A_MFXER, NR_R0));
+    list.concat(taicpu.op_const_reg(A_MTCRF, 128, NR_R0));
+    flags.cr := RS_CR0;
+    flags.flag := F_LE;
+    a_jmp_flags(list, flags, hl);
+  end else
+    a_jmp_cond(list, OC_AE, hl);
+  a_call_name(list, 'FPC_OVERFLOW');
+  a_label(list, hl);
+end;
+
+procedure tcgppc.g_intf_wrapper(list: TAAsmoutput; procdef: tprocdef; const
+  labelname: string; ioffset: longint);
+
+  procedure loadvmttor11;
+  var
+    href: treference;
+  begin
+    reference_reset_base(href, NR_R3, 0);
+    cg.a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11);
+  end;
+
+  procedure op_onr11methodaddr;
+  var
+    href: treference;
+  begin
+    if (procdef.extnumber = $FFFF) then
+      Internalerror(200006139);
+    { call/jmp  vmtoffs(%eax) ; method offs }
+    reference_reset_base(href, NR_R11,
+      procdef._class.vmtmethodoffset(procdef.extnumber));
+    if not ((aint(href.offset) >= low(smallint)) and
+      (aint(href.offset) <= high(smallint))) then begin
+      {$warning ts:adapt me}
+      list.concat(taicpu.op_reg_reg_const(A_ADDIS, NR_R11, NR_R11,
+        smallint((href.offset shr 16) + ord(smallint(href.offset and $FFFF) <
+        0))));
+      href.offset := smallint(href.offset and $FFFF);
+    end;
+    list.concat(taicpu.op_reg_ref(A_LD, NR_R11, href));
+    // the loaded reference is a function descriptor reference, so deref again
+    // (at ofs 0 there's the real pointer)
+    {$warning ts:TODO: update GOT reference}
+    reference_reset_base(href, NR_R11, 0);
+    list.concat(taicpu.op_reg_ref(A_LD, NR_R11, href));
+
+    list.concat(taicpu.op_reg(A_MTCTR, NR_R11));
+    list.concat(taicpu.op_none(A_BCTR));
+    // NOP needed for the linker...?
+    list.concat(taicpu.op_none(A_NOP));
+  end;
+
+var
+  make_global: boolean;
+begin
+  if procdef.proctypeoption <> potype_none then
+    Internalerror(200006137);
+  if not assigned(procdef._class) or
+    (procdef.procoptions * [po_classmethod, po_staticmethod,
+    po_methodpointer, po_interrupt, po_iocheck] <> []) then
+    Internalerror(200006138);
+  if procdef.owner.symtabletype <> objectsymtable then
+    Internalerror(200109191);
+
+  make_global := false;
+  if (not current_module.is_unit) or
+    (cs_create_smart in aktmoduleswitches) or
+    (procdef.owner.defowner.owner.symtabletype = globalsymtable) then
+    make_global := true;
+
+  if make_global then
+    List.concat(Tai_symbol.Createname_global(labelname, AT_FUNCTION, 0))
+  else
+    List.concat(Tai_symbol.Createname(labelname, AT_FUNCTION, 0));
+
+  { set param1 interface to self  }
+  g_adjust_self_value(list, procdef, ioffset);
+
+  { case 4 }
+  if po_virtualmethod in procdef.procoptions then begin
+    loadvmttor11;
+    op_onr11methodaddr;
+  end { case 0 } else
+    {$note ts:todo add GOT change?? - think not needed :) }
+    list.concat(taicpu.op_sym(A_B,
+      objectlibrary.newasmsymbol('.' + procdef.mangledname, AB_EXTERNAL,
+      AT_FUNCTION)));
+
+  List.concat(Tai_symbol_end.Createname(labelname));
+end;
+
+{***************** This is private property, keep out! :) *****************}
+
+function tcgppc.issimpleref(const ref: treference): boolean;
+
+begin
+  if (ref.base = NR_NO) and
+    (ref.index <> NR_NO) then
+    internalerror(200208101);
+  result :=
+    not (assigned(ref.symbol)) and
+    (((ref.index = NR_NO) and
+    (ref.offset >= low(smallint)) and
+    (ref.offset <= high(smallint))) or
+    ((ref.index <> NR_NO) and
+    (ref.offset = 0)));
+end;
+
+function tcgppc.fixref(list: taasmoutput; var ref: treference): boolean;
+
+var
+  tmpreg: tregister;
+begin
+  result := false;
+  if (ref.base = NR_NO) then
+  begin
+    ref.base := ref.index;
+    ref.base := NR_NO;
+  end;
+  if (ref.base <> NR_NO) then
+  begin
+    if (ref.index <> NR_NO) and
+      ((ref.offset <> 0) or assigned(ref.symbol)) then
+    begin
+      result := true;
+      tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+      list.concat(taicpu.op_reg_reg_reg(
+        A_ADD, tmpreg, ref.base, ref.index));
+      ref.index := NR_NO;
+      ref.base := tmpreg;
+    end
+  end
+  else if ref.index <> NR_NO then
+    internalerror(200208102);
+end;
+
+procedure tcgppc.a_load_store(list: taasmoutput; op: tasmop; reg: tregister;
+  ref: treference);
+
+var
+  tmpreg: tregister;
+  tmpref: treference;
+  largeOffset: Boolean;
+
+begin
+  tmpreg := NR_NO;
+
+  // if we have to load/store from a symbol or large addresses, use a temporary register
+  // containing the address
+    if assigned(ref.symbol) or (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then begin
+      tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE);
+      reference_reset(tmpref);
+      tmpref.symbol := ref.symbol;
+      tmpref.relsymbol := ref.relsymbol;
+      tmpref.offset := ref.offset;
+
+      (*
+      code template when there's no base register
+
+      lis rT,SYM+offs@highesta
+      addi rT,SYM+offs@highera
+      sldi rT,rT,32
+      addis rT,rT,SYM+offs@ha
+      ld rD,SYM+offs@l(rT)
+
+      code template when there's a base register
+
+      lis rT,SYM+offs@highesta
+      addis rT,SYM+offs@highera
+      sldi rT,rT,32
+      addis rT,rT,SYM+offs@ha
+      add  rT,rBase,rT
+      ld rD,SYM+offs@l(rT)
+
+      *)
+      //list.concat(tai_comment.create(strpnew('symbol: ' + tmpref.symbol.name + ' offset: ' + inttostr(tmpref.offset))));
+
+      tmpref.refaddr := addr_highesta;
+      list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref));
+      tmpref.refaddr := addr_highera;
+      list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref));
+      list.concat(taicpu.op_reg_reg_const(A_SLDI, tmpreg, tmpreg, 32));
+      tmpref.refaddr := addr_higha;
+      list.concat(taicpu.op_reg_reg_ref(A_ORIS, tmpreg, tmpreg, tmpref));
+
+      if (ref.base <> NR_NO) then begin
+        list.concat(taicpu.op_reg_reg_reg(A_ADD, tmpreg, tmpreg, ref.base));
+      end;
+
+      tmpref.base := tmpreg;
+      tmpref.refaddr := addr_low;
+      list.concat(taicpu.op_reg_ref(op, reg, tmpref));
+    end else begin
+      list.concat(taicpu.op_reg_ref(op, reg, ref));
+    end;
+end;
+
+procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflag;
+  crval: longint; l: tasmlabel);
+var
+  p: taicpu;
+
+begin
+  p := taicpu.op_sym(op, objectlibrary.newasmsymbol(l.name, AB_EXTERNAL,
+    AT_FUNCTION));
+  if op <> A_B then
+    create_cond_norm(c, crval, p.condition);
+  p.is_jmp := true;
+  list.concat(p)
+end;
+
+begin
+  cg := tcgppc.create;
+end.

+ 541 - 0
compiler/powerpc64/cpubase.pas

@@ -0,0 +1,541 @@
+{
+    Copyright (c) 1998-2002 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.
+
+ ****************************************************************************
+}
+{ This Unit contains the base types for the PowerPC
+}
+unit cpubase;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  strings, globtype,
+  cutils, cclasses, aasmbase, cpuinfo, cgbase;
+
+{*****************************************************************************
+                                Assembler Opcodes
+*****************************************************************************}
+
+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_dcbtst, a_dcbz, 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_fcmpo, 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_mcrxr, a_mfcr, a_mffs, a_mffs_, a_mfmsr, a_mfspr, a_mfsr,
+    a_mfsrin, a_mftb, a_mtcrf, a_mtfsb0, 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_rlwinm_, 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_stwcx_, 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, a_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_mr_, a_not, a_mtcr, a_mtlr, a_mflr,
+    a_mtctr, a_mfctr,
+    A_EXTSW,
+    A_RLDIMI,
+    A_STD, A_STDU, A_STDX, A_STDUX,
+    A_LD, A_LDU, A_LDX, A_LDUX,
+    A_CMPD, A_CMPDI, A_CMPLD, A_CMPLDI,
+    A_SRDI, A_SRADI,
+    A_SLDI,
+    A_RLDICL,
+    A_DIVDU, A_DIVD, A_MULLD, A_SRAD, A_SLD, A_SRD,
+    A_DIVDUO_, A_DIVDO_,
+    A_LWA, A_LWAU, A_LWAX, A_LWAUX,
+    A_FCFID,
+    A_LDARX, A_STDCX_, A_CNTLZD,
+    A_LVX, A_STVX,
+    A_MULLDO, A_MULLDO_, A_MULHDU, A_MULHDU_,
+    A_MFXER);
+
+  {# This should define the array of instructions as string }
+  op2strtable = array[tasmop] of string[8];
+
+const
+  {# First value of opcode enumeration }
+  firstop = low(tasmop);
+  {# Last value of opcode enumeration  }
+  lastop = high(tasmop);
+
+  {*****************************************************************************
+                                    Registers
+  *****************************************************************************}
+
+type
+  { Number of registers used for indexing in tables }
+  tregisterindex = 0..{$I rppcnor.inc} - 1;
+  totherregisterset = set of tregisterindex;
+
+const
+  maxvarregs = 32 - 6;
+    { 32 int registers - r0 - stackpointer - r2 - 3 scratch registers }
+  maxfpuvarregs = 28; { 32 fpuregisters - some scratch registers (minimally 2) }
+  { Available Superregisters }
+{$I rppcsup.inc}
+
+  { No Subregisters }
+  R_SUBWHOLE = R_SUBNONE;
+
+  { Available Registers }
+{$I rppccon.inc}
+
+  { Integer Super registers first and last }
+  first_int_imreg = $20;
+
+  { Float Super register first and last }
+  first_fpu_imreg = $20;
+
+  { MM Super register first and last }
+  first_mm_imreg = $20;
+
+{$WARNING TODO Calculate bsstart}
+  regnumber_count_bsstart = 64;
+
+  regnumber_table: array[tregisterindex] of tregister = (
+{$I rppcnum.inc}
+    );
+
+  regstabs_table: array[tregisterindex] of shortint = (
+{$I rppcstab.inc}
+    );
+
+  regdwarf_table: array[tregisterindex] of shortint = (
+{$I rppcdwrf.inc}
+    );
+
+  {*****************************************************************************
+                                  Conditions
+  *****************************************************************************}
+
+type
+  TAsmCondFlag = (C_None { unconditional jumps },
+    { 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);
+
+  TDirHint = (DH_None, DH_Minus, DH_Plus);
+
+const
+  { these are in the XER, but when moved to CR_x they correspond with the }
+  { bits below                                                            }
+  C_OV = C_GT;
+  C_CA = C_EQ;
+  C_NO = C_NG;
+  C_NC = C_NE;
+
+type
+  TAsmCond = packed record
+    dirhint: tdirhint;
+    case simple: boolean of
+      false: (BO, BI: byte);
+      true: (
+        cond: TAsmCondFlag;
+        case byte of
+          0: ();
+          { specifies in which part of the cr the bit has to be }
+          { tested for blt,bgt,beq,..,bnu                       }
+          1: (cr: RS_CR0..RS_CR7);
+          { specifies the bit to test for bt,bf,bdz,..,bdzf }
+          2: (crbit: byte)
+          );
+  end;
+
+const
+  AsmCondFlag2BO: array[C_T..C_DZF] of Byte =
+  (12, 4, 16, 8, 0, 18, 10, 2);
+
+  AsmCondFlag2BOLT_NU: array[C_LT..C_NU] of Byte =
+  (12, 4, 12, 4, 12, 4, 4, 4, 12, 4, 12, 4);
+
+  AsmCondFlag2BI: array[C_LT..C_NU] of Byte =
+  (0, 1, 2, 0, 1, 0, 2, 1, 3, 3, 3, 3);
+
+  AsmCondFlagTF: array[TAsmCondFlag] of Boolean =
+  (false, true, false, true, false, true, false, false, false, true, false,
+    true, false,
+    true, false, false, true, false, false, true, false);
+
+  AsmCondFlag2Str: array[TAsmCondFlag] of string[4] = ({cf_none}'',
+    { conditions when not using ctr decrement etc}
+    'lt', 'le', 'eq', 'ge', 'gt', 'nl', 'ne', 'ng', 'so', 'ns', 'un', 'nu',
+    't', 'f', 'dnz', 'dnzt', 'dnzf', 'dz', 'dzt', 'dzf');
+
+  UpperAsmCondFlag2Str: array[TAsmCondFlag] of string[4] = ({cf_none}'',
+    { conditions when not using ctr decrement etc}
+    'LT', 'LE', 'EQ', 'GE', 'GT', 'NL', 'NE', 'NG', 'SO', 'NS', 'UN', 'NU',
+    'T', 'F', 'DNZ', 'DNZT', 'DNZF', 'DZ', 'DZT', 'DZF');
+
+const
+  CondAsmOps = 3;
+  CondAsmOp: array[0..CondAsmOps - 1] of TasmOp = (
+    A_BC, A_TW, A_TWI
+    );
+
+  {*****************************************************************************
+                                     Flags
+  *****************************************************************************}
+
+type
+  TResFlagsEnum = (F_EQ, F_NE, F_LT, F_LE, F_GT, F_GE, F_SO, F_FX, F_FEX, F_VX,
+    F_OX);
+  TResFlags = record
+    cr: RS_CR0..RS_CR7;
+    flag: TResFlagsEnum;
+  end;
+
+{*****************************************************************************
+                              Reference
+*****************************************************************************}
+
+const
+  symaddr2str: array[trefaddr] of string[9] = ('', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta');
+
+const
+  { MacOS only. Whether the direct data area (TOC) directly contain
+    global variables. Otherwise it contains pointers to global variables. }
+  macos_direct_globals = false;
+
+  {*****************************************************************************
+                                  Operand Sizes
+  *****************************************************************************}
+
+  {*****************************************************************************
+                                   Constants
+  *****************************************************************************}
+
+const
+  max_operands = 5;
+
+  {*****************************************************************************
+                            Default generic sizes
+  *****************************************************************************}
+
+        {# Defines the default address size for a processor, }
+  OS_ADDR = OS_64;
+  {# the natural int size for a processor,             }
+  OS_INT = OS_64;
+  {# the maximum float size for a processor,           }
+  OS_FLOAT = OS_F64;
+  {# the size of a vector register for a processor     }
+  OS_VECTOR = OS_M128;
+
+  {*****************************************************************************
+                                 GDB Information
+  *****************************************************************************}
+
+        {# Register indexes for stabs information, when some
+           parameters or variables are stored in registers.
+
+           Taken from rs6000.h (DBX_REGISTER_NUMBER)
+           from GCC 3.x source code. PowerPC has 1:1 mapping
+           according to the order of the registers defined
+           in GCC
+
+        }
+
+  stab_regindex: array[tregisterindex] of shortint = (
+{$I rppcstab.inc}
+    );
+
+  {*****************************************************************************
+                            Generic Register names
+  *****************************************************************************}
+
+  // Stack pointer register
+  NR_STACK_POINTER_REG = NR_R1;
+  RS_STACK_POINTER_REG = RS_R1;
+  // Frame pointer register
+  NR_FRAME_POINTER_REG = NR_STACK_POINTER_REG;
+  RS_FRAME_POINTER_REG = RS_STACK_POINTER_REG;
+  {# Register for addressing absolute data in a position independant way,
+     such as in PIC code. The exact meaning is ABI specific. For
+     further information look at GCC source : PIC_OFFSET_TABLE_REGNUM
+
+     Taken from GCC rs6000.h
+  }
+{$WARNING As indicated in rs6000.h, but can't find it anywhere else!}
+  NR_PIC_OFFSET_REG = NR_R30;
+  { Return address of a function }
+  NR_RETURN_ADDRESS_REG = NR_R0;
+  { Results are returned in this register (64-bit values) }
+  NR_FUNCTION_RETURN_REG = NR_R3;
+  RS_FUNCTION_RETURN_REG = RS_R3;
+  { The value returned from a function is available in this register }
+  NR_FUNCTION_RESULT_REG = NR_FUNCTION_RETURN_REG;
+  RS_FUNCTION_RESULT_REG = RS_FUNCTION_RETURN_REG;
+
+  NR_FPU_RESULT_REG = NR_F1;
+  NR_MM_RESULT_REG = NR_M0;
+
+  {*****************************************************************************
+                         GCC /ABI linking information
+  *****************************************************************************}
+
+  {# Registers which must be saved when calling a routine declared as
+     cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers
+     saved should be the ones as defined in the target ABI and / or GCC.
+
+     This value can be deduced from CALLED_USED_REGISTERS array in the
+     GCC source.
+  }
+  saved_standard_registers: array[0..17] of tsuperregister = (
+    RS_R14, RS_R15, RS_R16, RS_R17, RS_R18, RS_R19,
+    RS_R20, RS_R21, RS_R22, RS_R23, RS_R24, RS_R25,
+    RS_R26, RS_R27, RS_R28, RS_R29, RS_R30, RS_R31
+    );
+
+  {# Required parameter alignment when calling a routine declared as
+     stdcall and cdecl. The alignment value should be the one defined
+     by GCC or the target ABI.
+  }
+  std_param_align = 16;
+
+  {*****************************************************************************
+                              CPU Dependent Constants
+  *****************************************************************************}
+
+  LinkageAreaSizeELF = 48;
+  { 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_ELF = 8;
+  { offset in the linkage area for the saved link register}
+  LA_LR_ELF = 16;
+  { offset in the linkage area for the saved RTOC register}
+  LA_RTOC_ELF = 40;
+
+  PARENT_FRAMEPOINTER_OFFSET = 24;
+
+  NR_RTOC = NR_R2;
+
+  ELF_STACK_ALIGN = 16;
+
+  {*****************************************************************************
+                                    Helpers
+  *****************************************************************************}
+
+function is_calljmp(o: tasmop): boolean;
+
+procedure inverse_flags(var r: TResFlags);
+function flags_to_cond(const f: TResFlags): TAsmCond;
+procedure create_cond_imm(BO, BI: byte; var r: TAsmCond);
+procedure create_cond_norm(cond: TAsmCondFlag; cr: byte; var r: TasmCond);
+
+function cgsize2subreg(s: Tcgsize): Tsubregister;
+{ Returns the tcgsize corresponding with the size of reg.}
+function reg_cgsize(const reg: tregister): tcgsize;
+
+function findreg_by_number(r: Tregister): tregisterindex;
+function std_regnum_search(const s: string): Tregister;
+function std_regname(r: Tregister): string;
+function is_condreg(r: tregister): boolean;
+
+function inverse_cond(const c: TAsmCond): Tasmcond;
+{$IFDEF USEINLINE}inline;
+{$ENDIF USEINLINE}
+function conditions_equal(const c1, c2: TAsmCond): boolean;
+
+implementation
+
+uses
+  rgBase, verbose;
+
+const
+  std_regname_table: array[tregisterindex] of string[7] = (
+{$I rppcstd.inc}
+    );
+
+  regnumber_index: array[tregisterindex] of tregisterindex = (
+{$I rppcrni.inc}
+    );
+
+  std_regname_index: array[tregisterindex] of tregisterindex = (
+{$I rppcsri.inc}
+    );
+
+  {*****************************************************************************
+                                    Helpers
+  *****************************************************************************}
+
+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 inverse_flags(var r: TResFlags);
+const
+  inv_flags: array[F_EQ..F_GE] of TResFlagsEnum =
+  (F_NE, F_EQ, F_GE, F_GE, F_LE, F_LT);
+begin
+  r.flag := inv_flags[r.flag];
+end;
+
+function inverse_cond(const c: TAsmCond): Tasmcond;
+{$IFDEF USEINLINE}inline;
+{$ENDIF USEINLINE}
+const
+  inv_condflags: array[TAsmCondFlag] of TAsmCondFlag = (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
+  if (c.cond in [C_DNZ, C_DZ]) then
+    internalerror(2005022501);
+  result := c;
+  result.cond := inv_condflags[c.cond];
+end;
+
+function conditions_equal(const c1, c2: TAsmCond): boolean;
+begin
+  result :=
+    (c1.simple and c2.simple) and
+    (c1.cond = c2.cond) and
+    ((not (c1.cond in [C_T..C_DZF]) and
+    (c1.cr = c2.cr)) or
+    (c1.crbit = c2.crbit));
+end;
+
+function flags_to_cond(const f: TResFlags): TAsmCond;
+const
+  flag_2_cond: array[F_EQ..F_SO] of TAsmCondFlag =
+  (C_EQ, C_NE, C_LT, C_LE, C_GT, C_GE, C_SO);
+begin
+  if f.flag > high(flag_2_cond) then
+    internalerror(200112301);
+  result.simple := true;
+  result.cr := f.cr;
+  result.cond := flag_2_cond[f.flag];
+end;
+
+procedure create_cond_imm(BO, BI: byte; var r: TAsmCond);
+begin
+  r.simple := false;
+  r.bo := bo;
+  r.bi := bi;
+end;
+
+procedure create_cond_norm(cond: TAsmCondFlag; cr: byte; var r: TasmCond);
+begin
+  r.simple := true;
+  r.cond := cond;
+  case cond of
+    C_NONE: ;
+    C_T..C_DZF: r.crbit := cr
+  else
+    r.cr := RS_CR0 + cr;
+  end;
+end;
+
+function is_condreg(r: tregister): boolean;
+var
+  supreg: tsuperregister;
+begin
+  result := false;
+  if (getregtype(r) = R_SPECIALREGISTER) then
+  begin
+    supreg := getsupreg(r);
+    result := (supreg >= RS_CR0) and (supreg <= RS_CR7);
+  end;
+end;
+
+function reg_cgsize(const reg: tregister): tcgsize;
+begin
+  case getregtype(reg) of
+    R_MMREGISTER,
+      R_FPUREGISTER,
+      R_INTREGISTER:
+      result := OS_64;
+  else
+    internalerror(200303181);
+  end;
+end;
+
+function cgsize2subreg(s: Tcgsize): Tsubregister;
+begin
+  cgsize2subreg := R_SUBWHOLE;
+end;
+
+function findreg_by_number(r: Tregister): tregisterindex;
+begin
+  result := rgBase.findreg_by_number_table(r, regnumber_index);
+end;
+
+function std_regnum_search(const s: string): Tregister;
+begin
+  result := regnumber_table[findreg_by_name_table(s, std_regname_table,
+    std_regname_index)];
+end;
+
+function std_regname(r: Tregister): string;
+var
+  p: tregisterindex;
+begin
+  p := findreg_by_number_table(r, regnumber_index);
+  if p <> 0 then
+    result := std_regname_table[p]
+  else
+    result := generic_regname(r);
+end;
+
+end.
+

+ 69 - 0
compiler/powerpc64/cpuinfo.pas

@@ -0,0 +1,69 @@
+{
+    Copyright (c) 1998-2002 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
+
+uses
+  globtype;
+
+type
+  bestreal = double;
+  ts32real = single;
+  ts64real = double;
+  ts80real = extended;
+  ts128real = extended;
+  ts64comp = comp;
+
+  pbestreal = ^bestreal;
+
+  { possible supported processors for this target }
+  tprocessors =
+    (no_processor,
+    ppc970
+    );
+
+  tfputype =
+    (no_fpuprocessor,
+    fpu_soft,
+    fpu_standard
+    );
+
+const
+  { calling conventions supported by the code generator }
+  supported_calling_conventions: tproccalloptions = [
+    pocall_internproc,
+    pocall_stdcall,
+    { the difference to stdcall is only the name mangling }
+    pocall_cdecl,
+    { the difference to stdcall is only the name mangling }
+    pocall_cppdecl,
+    { pass all const records by reference }
+    pocall_mwpascal
+    ];
+
+  processorsstr: array[tprocessors] of string[10] = ('',
+    '970'
+    );
+
+  fputypestr: array[tfputype] of string[8] = ('',
+    'SOFT',
+    'STANDARD'
+    );
+
+implementation
+
+end.
+

+ 51 - 0
compiler/powerpc64/cpunode.pas

@@ -0,0 +1,51 @@
+{
+    Copyright (c) 2000-2002 by Florian Klaempfl
+
+    Includes the PowerPC64 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 cpunode;
+
+{$I fpcdefs.inc}
+
+interface
+
+implementation
+
+uses
+  { generic nodes }
+  ncgbas, ncgld, ncgflw, ncgcnv, ncgmem, ncgcon, ncgcal, ncgset, ncginl, ncgopt,
+  { to be able to only parts of the generic code,
+    the processor specific nodes must be included
+    after the generic one (FK)
+  }
+  nppcadd,
+  nppccal,
+  //       nppccon,
+  //       nppcflw,
+  //       nppcmem,
+  nppcset,
+  nppcinl,
+  //       nppcopt,
+  nppcmat,
+  nppccnv,
+  nppcld
+  ;
+
+end.
+

+ 576 - 0
compiler/powerpc64/cpupara.pas

@@ -0,0 +1,576 @@
+{
+    Copyright (c) 2002 by Florian Klaempfl
+
+    PowerPC64 specific calling conventions
+
+    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 cpupara;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  globtype,
+  aasmtai,
+  cpubase,
+  symconst, symtype, symdef, symsym,
+  paramgr, parabase, cgbase;
+
+type
+  tppcparamanager = class(tparamanager)
+    function get_volatile_registers_int(calloption: tproccalloption):
+      tcpuregisterset; override;
+    function get_volatile_registers_fpu(calloption: tproccalloption):
+      tcpuregisterset; override;
+    function push_addr_param(varspez: tvarspez; def: tdef; calloption:
+      tproccalloption): boolean; override;
+
+    procedure getintparaloc(calloption: tproccalloption; nr: longint; var
+      cgpara: TCGPara); override;
+    function create_paraloc_info(p: tabstractprocdef; side: tcallercallee):
+      longint; override;
+    function create_varargs_paraloc_info(p: tabstractprocdef; varargspara:
+      tvarargsparalist): longint; override;
+    procedure create_funcretloc_info(p: tabstractprocdef; side: tcallercallee);
+
+  private
+    procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister;
+      var cur_stack_offset: aword);
+    function create_paraloc_info_intern(p: tabstractprocdef; side:
+      tcallercallee; paras: tparalist;
+      var curintreg, curfloatreg, curmmreg: tsuperregister; var
+        cur_stack_offset: aword): longint;
+    function parseparaloc(p: tparavarsym; const s: string): boolean; override;
+  end;
+
+implementation
+
+uses
+  verbose, systems,
+  defutil,
+  cgutils;
+
+function tppcparamanager.get_volatile_registers_int(calloption:
+  tproccalloption): tcpuregisterset;
+begin
+  result := [RS_R3..RS_R12];
+end;
+
+function tppcparamanager.get_volatile_registers_fpu(calloption:
+  tproccalloption): tcpuregisterset;
+begin
+  result := [RS_F0..RS_F13];
+end;
+
+procedure tppcparamanager.getintparaloc(calloption: tproccalloption; nr:
+  longint; var cgpara: TCGPara);
+var
+  paraloc: pcgparalocation;
+begin
+  cgpara.reset;
+  cgpara.size := OS_INT;
+  cgpara.intsize := tcgsize2size[OS_INT];
+  cgpara.alignment := get_para_align(calloption);
+  paraloc := cgpara.add_location;
+  with paraloc^ do
+  begin
+    size := OS_INT;
+    if (nr <= 8) then
+    begin
+      if nr = 0 then
+        internalerror(200309271);
+      loc := LOC_REGISTER;
+      register := newreg(R_INTREGISTER, RS_R2 + nr, R_SUBWHOLE);
+    end
+    else
+    begin
+      loc := LOC_REFERENCE;
+      paraloc^.reference.index := NR_STACK_POINTER_REG;
+      if (target_info.abi <> abi_powerpc_aix) then
+        reference.offset := sizeof(aint) * (nr - 8)
+      else
+        reference.offset := sizeof(aint) * (nr);
+    end;
+  end;
+end;
+
+function getparaloc(p: tdef): tcgloc;
+
+begin
+  { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
+    if push_addr_param for the def is true
+  }
+  case p.deftype of
+    orddef:
+      result := LOC_REGISTER;
+    floatdef:
+      result := LOC_FPUREGISTER;
+    enumdef:
+      result := LOC_REGISTER;
+    pointerdef:
+      result := LOC_REGISTER;
+    formaldef:
+      result := LOC_REGISTER;
+    classrefdef:
+      result := LOC_REGISTER;
+    recorddef:
+      if (target_info.abi <> abi_powerpc_aix) then
+        result := LOC_REFERENCE
+      else
+        result := LOC_REGISTER;
+    objectdef:
+      if is_object(p) then
+        result := LOC_REFERENCE
+      else
+        result := LOC_REGISTER;
+    stringdef:
+      if is_shortstring(p) or is_longstring(p) then
+        result := LOC_REFERENCE
+      else
+        result := LOC_REGISTER;
+    procvardef:
+      if (po_methodpointer in tprocvardef(p).procoptions) then
+        result := LOC_REFERENCE
+      else
+        result := LOC_REGISTER;
+    filedef:
+      result := LOC_REGISTER;
+    arraydef:
+      result := LOC_REFERENCE;
+    setdef:
+      if is_smallset(p) then
+        result := LOC_REGISTER
+      else
+        result := LOC_REFERENCE;
+    variantdef:
+      result := LOC_REFERENCE;
+    { avoid problems with errornous definitions }
+    errordef:
+      result := LOC_REGISTER;
+  else
+    internalerror(2002071001);
+  end;
+end;
+
+function tppcparamanager.push_addr_param(varspez: tvarspez; def: tdef;
+  calloption: tproccalloption): boolean;
+begin
+  result := false;
+  { var,out always require address }
+  if varspez in [vs_var, vs_out] then
+  begin
+    result := true;
+    exit;
+  end;
+  case def.deftype of
+    variantdef,
+      formaldef:
+      result := true;
+    recorddef:
+      result :=
+        (target_info.abi <> abi_powerpc_aix) or
+        ((varspez = vs_const) and
+        ((calloption = pocall_mwpascal) or
+        (not (calloption in [pocall_cdecl, pocall_cppdecl]) and
+        (def.size > 8)
+        )
+        )
+        );
+    arraydef:
+      result := (tarraydef(def).highrange >= tarraydef(def).lowrange) or
+        is_open_array(def) or
+        is_array_of_const(def) or
+        is_array_constructor(def);
+    objectdef:
+      result := is_object(def);
+    setdef:
+      result := (tsetdef(def).settype <> smallset);
+    stringdef:
+      result := tstringdef(def).string_typ in [st_shortstring, st_longstring];
+    procvardef:
+      result := po_methodpointer in tprocvardef(def).procoptions;
+  end;
+end;
+
+procedure tppcparamanager.init_values(var curintreg, curfloatreg, curmmreg:
+  tsuperregister; var cur_stack_offset: aword);
+begin
+  cur_stack_offset := 48;
+  curintreg := RS_R3;
+  curfloatreg := RS_F1;
+  curmmreg := RS_M1;
+end;
+
+procedure tppcparamanager.create_funcretloc_info(p: tabstractprocdef; side:
+  tcallercallee);
+var
+  retcgsize: tcgsize;
+begin
+  { Constructors return self instead of a boolean }
+  if (p.proctypeoption = potype_constructor) then
+    retcgsize := OS_ADDR
+  else
+    retcgsize := def_cgsize(p.rettype.def);
+
+  location_reset(p.funcretloc[side], LOC_INVALID, OS_NO);
+  p.funcretloc[side].size := retcgsize;
+  { void has no location }
+  if is_void(p.rettype.def) then
+  begin
+    p.funcretloc[side].loc := LOC_VOID;
+    exit;
+  end;
+
+  { Return in FPU register? }
+  if p.rettype.def.deftype = floatdef then
+  begin
+    p.funcretloc[side].loc := LOC_FPUREGISTER;
+    p.funcretloc[side].register := NR_FPU_RESULT_REG;
+    p.funcretloc[side].size := retcgsize;
+  end
+  else
+    { Return in register? } if not ret_in_param(p.rettype.def, p.proccalloption)
+      then
+    begin
+      begin
+        p.funcretloc[side].loc := LOC_REGISTER;
+        p.funcretloc[side].size := retcgsize;
+        if side = callerside then
+          p.funcretloc[side].register := newreg(R_INTREGISTER,
+            RS_FUNCTION_RESULT_REG, cgsize2subreg(retcgsize))
+        else
+          p.funcretloc[side].register := newreg(R_INTREGISTER,
+            RS_FUNCTION_RETURN_REG, cgsize2subreg(retcgsize));
+      end;
+    end
+    else
+    begin
+      p.funcretloc[side].loc := LOC_REFERENCE;
+      p.funcretloc[side].size := retcgsize;
+    end;
+end;
+
+function tppcparamanager.create_paraloc_info(p: tabstractprocdef; side:
+  tcallercallee): longint;
+
+var
+  cur_stack_offset: aword;
+  curintreg, curfloatreg, curmmreg: tsuperregister;
+begin
+  init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset);
+
+  result := create_paraloc_info_intern(p, side, p.paras, curintreg, curfloatreg,
+    curmmreg, cur_stack_offset);
+
+  create_funcretloc_info(p, side);
+end;
+
+function tppcparamanager.create_paraloc_info_intern(p: tabstractprocdef; side:
+  tcallercallee; paras: tparalist;
+  var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset:
+    aword): longint;
+var
+  stack_offset: longint;
+  paralen: aint;
+  nextintreg, nextfloatreg, nextmmreg, maxfpureg: tsuperregister;
+  paradef: tdef;
+  paraloc: pcgparalocation;
+  i: integer;
+  hp: tparavarsym;
+  loc: tcgloc;
+  paracgsize: tcgsize;
+
+begin
+{$IFDEF extdebug}
+  if po_explicitparaloc in p.procoptions then
+    internalerror(200411141);
+{$ENDIF extdebug}
+
+  result := 0;
+  nextintreg := curintreg;
+  nextfloatreg := curfloatreg;
+  nextmmreg := curmmreg;
+  stack_offset := cur_stack_offset;
+
+  maxfpureg := RS_F13;
+
+  for i := 0 to paras.count - 1 do
+  begin
+    hp := tparavarsym(paras[i]);
+    paradef := hp.vartype.def;
+    { Syscall for Morphos can have already a paraloc set }
+    if (vo_has_explicit_paraloc in hp.varoptions) then
+    begin
+      if not (vo_is_syscall_lib in hp.varoptions) then
+        internalerror(200412153);
+      continue;
+    end;
+    hp.paraloc[side].reset;
+    { currently only support C-style array of const }
+    if (p.proccalloption in [pocall_cdecl, pocall_cppdecl]) and
+      is_array_of_const(paradef) then
+    begin
+      paraloc := hp.paraloc[side].add_location;
+      { hack: the paraloc must be valid, but is not actually used }
+      paraloc^.loc := LOC_REGISTER;
+      paraloc^.register := NR_R0;
+      paraloc^.size := OS_ADDR;
+      break;
+    end;
+
+    if (hp.varspez in [vs_var, vs_out]) or
+      push_addr_param(hp.varspez, paradef, p.proccalloption) or
+      is_open_array(paradef) or
+      is_array_of_const(paradef) then
+    begin
+      paradef := voidpointertype.def;
+      loc := LOC_REGISTER;
+      paracgsize := OS_ADDR;
+      paralen := tcgsize2size[OS_ADDR];
+    end
+    else
+    begin
+      if not is_special_array(paradef) then
+        paralen := paradef.size
+      else
+        paralen := tcgsize2size[def_cgsize(paradef)];
+      if (target_info.abi = abi_powerpc_aix) and
+        (paradef.deftype = recorddef) and
+        (hp.varspez in [vs_value, vs_const]) then
+      begin
+        { if a record has only one field and that field is }
+        { non-composite (not array or record), it must be  }
+        { passed according to the rules of that type.       }
+        if (trecorddef(hp.vartype.def).symtable.symindex.count = 1) and
+          (not trecorddef(hp.vartype.def).isunion) and
+          ((tabstractvarsym(trecorddef(hp.vartype.def).symtable.symindex.search(1)).vartype.def.deftype = floatdef) or
+          ((target_info.system = system_powerpc_darwin) and
+          (tabstractvarsym(trecorddef(hp.vartype.def).symtable.symindex.search(1)).vartype.def.deftype in [orddef, enumdef]))) then
+        begin
+          paradef :=
+            tabstractvarsym(trecorddef(hp.vartype.def).symtable.symindex.search(1)).vartype.def;
+          loc := getparaloc(paradef);
+          paracgsize := def_cgsize(paradef);
+        end
+        else
+        begin
+          loc := LOC_REGISTER;
+          paracgsize := int_cgsize(paralen);
+        end;
+      end
+      else
+      begin
+        loc := getparaloc(paradef);
+        paracgsize := def_cgsize(paradef);
+        { for things like formaldef }
+        if (paracgsize = OS_NO) then
+        begin
+          paracgsize := OS_ADDR;
+          paralen := tcgsize2size[OS_ADDR];
+        end;
+      end
+    end;
+    hp.paraloc[side].alignment := std_param_align;
+    hp.paraloc[side].size := paracgsize;
+    hp.paraloc[side].intsize := paralen;
+    if (paralen = 0) then
+      if (paradef.deftype = recorddef) then
+      begin
+        paraloc := hp.paraloc[side].add_location;
+        paraloc^.loc := LOC_VOID;
+      end
+      else
+        internalerror(2005011310);
+    { can become < 0 for e.g. 3-byte records }
+    while (paralen > 0) do
+    begin
+      paraloc := hp.paraloc[side].add_location;
+      if (loc = LOC_REGISTER) and
+        (nextintreg <= RS_R10) then
+      begin
+        paraloc^.loc := loc;
+        { make sure we don't lose whether or not the type is signed }
+        if (paradef.deftype <> orddef) then
+          paracgsize := int_cgsize(paralen);
+        if (paracgsize in [OS_NO]) then
+          paraloc^.size := OS_INT
+        else
+          paraloc^.size := paracgsize;
+        paraloc^.register := newreg(R_INTREGISTER, nextintreg, R_SUBNONE);
+        inc(nextintreg);
+        dec(paralen, tcgsize2size[paraloc^.size]);
+        if target_info.abi = abi_powerpc_aix then
+          inc(stack_offset, tcgsize2size[paraloc^.size]);
+      end
+      else if (loc = LOC_FPUREGISTER) and
+        (nextfloatreg <= maxfpureg) then
+      begin
+        paraloc^.loc := loc;
+        paraloc^.size := paracgsize;
+        paraloc^.register := newreg(R_FPUREGISTER, nextfloatreg, R_SUBWHOLE);
+        inc(nextfloatreg);
+        dec(paralen, tcgsize2size[paraloc^.size]);
+        { if nextfpureg > maxfpureg, all intregs are already used, since there }
+        { are less of those available for parameter passing in the AIX abi     }
+      end
+      else { LOC_REFERENCE }
+      begin
+        paraloc^.loc := LOC_REFERENCE;
+        paraloc^.size := int_cgsize(paralen);
+        if (side = callerside) then
+          paraloc^.reference.index := NR_STACK_POINTER_REG
+        else
+          paraloc^.reference.index := NR_R12;
+        paraloc^.reference.offset := stack_offset;
+        inc(stack_offset, align(paralen, 8));
+        paralen := 0;
+      end;
+    end;
+  end;
+  curintreg := nextintreg;
+  curfloatreg := nextfloatreg;
+  curmmreg := nextmmreg;
+  cur_stack_offset := stack_offset;
+  result := stack_offset;
+end;
+
+function tppcparamanager.create_varargs_paraloc_info(p: tabstractprocdef;
+  varargspara: tvarargsparalist): longint;
+var
+  cur_stack_offset: aword;
+  parasize, l: longint;
+  curintreg, firstfloatreg, curfloatreg, curmmreg: tsuperregister;
+  i: integer;
+  hp: tparavarsym;
+  paraloc: pcgparalocation;
+begin
+  init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset);
+  firstfloatreg := curfloatreg;
+
+  result := create_paraloc_info_intern(p, callerside, p.paras, curintreg,
+    curfloatreg, curmmreg, cur_stack_offset);
+  if (p.proccalloption in [pocall_cdecl, pocall_cppdecl]) then
+    { just continue loading the parameters in the registers }
+  begin
+    result := create_paraloc_info_intern(p, callerside, varargspara, curintreg,
+      curfloatreg, curmmreg, cur_stack_offset);
+    { varargs routines have to reserve at least 64 bytes for the AIX abi }
+    { ts: dunno??? }
+    if (target_info.abi = abi_powerpc_aix) and
+      (result < 64) then
+      result := 64;
+  end
+  else
+  begin
+    parasize := cur_stack_offset;
+    for i := 0 to varargspara.count - 1 do
+    begin
+      hp := tparavarsym(varargspara[i]);
+      hp.paraloc[callerside].alignment := 8;
+      paraloc := hp.paraloc[callerside].add_location;
+      paraloc^.loc := LOC_REFERENCE;
+      paraloc^.size := def_cgsize(hp.vartype.def);
+      paraloc^.reference.index := NR_STACK_POINTER_REG;
+      l := push_size(hp.varspez, hp.vartype.def, p.proccalloption);
+      paraloc^.reference.offset := parasize;
+      parasize := parasize + l;
+    end;
+    result := parasize;
+  end;
+  if curfloatreg <> firstfloatreg then
+    include(varargspara.varargsinfo, va_uses_float_reg);
+end;
+
+function tppcparamanager.parseparaloc(p: tparavarsym; const s: string): boolean;
+var
+  paraloc: pcgparalocation;
+  paracgsize: tcgsize;
+begin
+  result := false;
+  case target_info.system of
+    system_powerpc_morphos:
+      begin
+        paracgsize := def_cgsize(p.vartype.def);
+        p.paraloc[callerside].alignment := 8;
+        p.paraloc[callerside].size := paracgsize;
+        p.paraloc[callerside].intsize := tcgsize2size[paracgsize];
+        paraloc := p.paraloc[callerside].add_location;
+        paraloc^.loc := LOC_REFERENCE;
+        paraloc^.size := paracgsize;
+        paraloc^.reference.index := newreg(R_INTREGISTER, RS_R2, R_SUBWHOLE);
+        { pattern is always uppercase'd }
+        if s = 'D0' then
+          paraloc^.reference.offset := 0
+        else if s = 'D1' then
+          paraloc^.reference.offset := 8
+        else if s = 'D2' then
+          paraloc^.reference.offset := 16
+        else if s = 'D3' then
+          paraloc^.reference.offset := 24
+        else if s = 'D4' then
+          paraloc^.reference.offset := 32
+        else if s = 'D5' then
+          paraloc^.reference.offset := 40
+        else if s = 'D6' then
+          paraloc^.reference.offset := 48
+        else if s = 'D7' then
+          paraloc^.reference.offset := 56
+        else if s = 'A0' then
+          paraloc^.reference.offset := 64
+        else if s = 'A1' then
+          paraloc^.reference.offset := 72
+        else if s = 'A2' then
+          paraloc^.reference.offset := 80
+        else if s = 'A3' then
+          paraloc^.reference.offset := 88
+        else if s = 'A4' then
+          paraloc^.reference.offset := 96
+        else if s = 'A5' then
+          paraloc^.reference.offset := 104
+            { 'A6' (offset 56) is used by mossyscall as libbase, so API
+            never passes parameters in it,
+            Indeed, but this allows to declare libbase either explicitly
+            or let the compiler insert it }
+        else if s = 'A6' then
+          paraloc^.reference.offset := 112
+            { 'A7' is the stack pointer on 68k, can't be overwritten
+            by API calls, so it has no offset }
+          { 'R12' is special, used internally to support r12base sysv
+            calling convention }
+        else if s = 'R12' then
+        begin
+          paraloc^.loc := LOC_REGISTER;
+          paraloc^.size := OS_ADDR;
+          paraloc^.register := NR_R12;
+        end
+        else
+          exit;
+
+        { copy to callee side }
+        p.paraloc[calleeside].add_location^ := paraloc^;
+      end;
+  else
+    internalerror(200404182);
+  end;
+  result := true;
+end;
+
+begin
+  paramanager := tppcparamanager.create;
+end.
+

+ 109 - 0
compiler/powerpc64/cpupi.pas

@@ -0,0 +1,109 @@
+{
+    Copyright (c) 2002 by Florian Klaempfl
+
+    This unit contains the CPU specific part of tprocinfo
+
+    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.
+
+ ****************************************************************************
+}
+
+{ This unit contains the CPU specific part of tprocinfo. }
+unit cpupi;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  cutils,
+  procinfo, cpuinfo, psub;
+
+type
+  tppcprocinfo = class(tcgprocinfo)
+    { offset where the frame pointer from the outer procedure is stored. }
+    parent_framepointer_offset: longint;
+    constructor create(aparent: tprocinfo); override;
+    procedure set_first_temp_offset; override;
+    procedure allocate_push_parasize(size: longint); override;
+    function calc_stackframe_size: longint; override;
+    function calc_stackframe_size(numgpr, numfpr : longint): longint;
+  end;
+
+implementation
+
+uses
+  globtype, globals, systems,
+  cpubase, cgbase,
+  aasmtai,
+  tgobj,
+  symconst, symsym, paramgr, symutil,
+  verbose;
+
+constructor tppcprocinfo.create(aparent: tprocinfo);
+
+begin
+  inherited create(aparent);
+  maxpushedparasize := 0;
+end;
+
+procedure tppcprocinfo.set_first_temp_offset;
+var
+  ofs: aword;
+  locals: longint;
+begin
+  if not (po_assembler in procdef.procoptions) then begin
+    { always allocate space for 8 * 8 bytes for registers R3-R10 and stack header if
+      there's a stack frame }
+    if (maxpushedparasize < 64) then begin
+      maxpushedparasize := 64;
+    end;
+    ofs := align(maxpushedparasize + LinkageAreaSizeELF, ELF_STACK_ALIGN);
+    tg.setfirsttemp(ofs);
+  end else begin
+    locals := 0;
+    current_procinfo.procdef.localst.foreach_static(@count_locals, @locals);
+    if locals <> 0 then
+      { at 0(r1), the previous value of r1 will be stored }
+      tg.setfirsttemp(8);
+  end;
+end;
+
+procedure tppcprocinfo.allocate_push_parasize(size: longint);
+begin
+  if size > maxpushedparasize then
+    maxpushedparasize := size;
+end;
+
+function tppcprocinfo.calc_stackframe_size: longint;
+begin
+  calc_stackframe_size(18, 18);
+end;
+
+function tppcprocinfo.calc_stackframe_size(numgpr, numfpr : longint) : longint;
+begin
+  { more or less copied from cgcpu.pas/g_stackframe_entry }
+  if not (po_assembler in procdef.procoptions) then begin
+    // no VMX support
+    result := align(align(numgpr * tcgsize2size[OS_INT] +
+      numfpr * tcgsize2size[OS_FLOAT], ELF_STACK_ALIGN) + tg.lasttemp, ELF_STACK_ALIGN);
+  end else
+    result := align(tg.lasttemp, ELF_STACK_ALIGN);
+end;
+
+begin
+  cprocinfo := tppcprocinfo;
+end.
+

+ 125 - 0
compiler/powerpc64/cpuswtch.pas

@@ -0,0 +1,125 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
+
+    interprets the commandline options which are PowerPC64 specific
+
+    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 cpuswtch;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  options;
+
+type
+  toptionpowerpc = class(toption)
+    procedure interpret_proc_specific_options(const opt: string); override;
+  end;
+
+implementation
+
+uses
+  cutils, globtype, systems, globals;
+
+procedure toptionpowerpc.interpret_proc_specific_options(const opt: string);
+var
+  more: string;
+  j: longint;
+begin
+  More := Upper(copy(opt, 3, length(opt) - 2));
+  case opt[2] of
+    'O':
+      begin
+        j := 3;
+        while (j <= Length(Opt)) do
+        begin
+          case opt[j] of
+            '-':
+              begin
+                initglobalswitches := initglobalswitches - [cs_optimize,
+                  cs_fastoptimize, cs_slowoptimize, cs_littlesize,
+                  cs_regvars, cs_uncertainopts];
+                FillChar(ParaAlignment, sizeof(ParaAlignment), 0);
+              end;
+            'a':
+              begin
+                UpdateAlignmentStr(Copy(Opt, j + 1, 255), ParaAlignment);
+                j := length(Opt);
+              end;
+            'g': initglobalswitches := initglobalswitches + [cs_littlesize];
+            'G': initglobalswitches := initglobalswitches - [cs_littlesize];
+            'r':
+              begin
+                initglobalswitches := initglobalswitches + [cs_regvars];
+                Simplify_ppu := false;
+              end;
+            'u': initglobalswitches := initglobalswitches + [cs_uncertainopts];
+            '1': initglobalswitches := initglobalswitches - [cs_fastoptimize,
+              cs_slowoptimize] + [cs_optimize];
+            '2': initglobalswitches := initglobalswitches - [cs_slowoptimize] +
+              [cs_optimize, cs_fastoptimize];
+            '3': initglobalswitches := initglobalswitches + [cs_optimize,
+              cs_fastoptimize, cs_slowoptimize];
+{$IFDEF dummy}
+            'p':
+              begin
+                if j < Length(Opt) then
+                begin
+                  case opt[j + 1] of
+                    '1': initoptprocessor := Class386;
+                    '2': initoptprocessor := ClassP5;
+                    '3': initoptprocessor := ClassP6
+                  else
+                    IllegalPara(Opt)
+                  end;
+                  Inc(j);
+                end
+                else
+                  IllegalPara(opt)
+              end;
+{$ENDIF dummy}
+          else
+            IllegalPara(opt);
+          end;
+          Inc(j)
+        end;
+      end;
+{$IFDEF dummy}
+    'R':
+      begin
+        if More = 'GAS' then
+          initasmmode := asmmode_ppc_gas
+        else if More = 'MOTOROLA' then
+          initasmmode := asmmode_ppc_motorola
+        else if More = 'DIRECT' then
+          initasmmode := asmmode_direct
+        else
+          IllegalPara(opt);
+      end;
+{$ENDIF dummy}
+  else
+    IllegalPara(opt);
+  end;
+end;
+
+initialization
+  coption := toptionpowerpc;
+end.
+

+ 67 - 0
compiler/powerpc64/cputarg.pas

@@ -0,0 +1,67 @@
+{
+    Copyright (c) 2001-2002 by Peter Vreman
+
+    Includes the powerpc dependent target units
+
+    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 cputarg;
+
+{$I fpcdefs.inc}
+
+interface
+
+implementation
+
+uses
+  systems { prevent a syntax error when nothing is included }
+
+  {**************************************
+               Targets
+  **************************************}
+
+{$IFNDEF NOTARGETLINUX}
+  , t_linux
+{$ENDIF}
+{$IFNDEF NOTARGETMACOS}
+  , t_macos
+{$ENDIF}
+{$IFNDEF NOTARGETDARWIN}
+  , t_bsd
+{$ENDIF}
+{$IFNDEF NOTARGETMORPHOS}
+  , t_morph
+{$ENDIF}
+
+  {**************************************
+               Assemblers
+  **************************************}
+
+{$IFNDEF NOAGPPCGAS}
+  , agppcgas
+{$ENDIF}
+  {**************************************
+               Optimizer
+  **************************************}
+
+{$IFNDEF NOOPT}
+  , aoptcpu
+{$ENDIF NOOPT}
+  ;
+
+end.
+

+ 158 - 0
compiler/powerpc64/itcpugas.pas

@@ -0,0 +1,158 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit contains the PowerPC GAS instruction tables
+
+    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 itcpugas;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  cpubase, cgbase;
+
+const
+  gas_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', 'dcbtst', 'dcbz', 'divw', 'divw.', 'divwo',
+      'divwo.',
+    'divwu', 'divwu.', 'divwuo', 'divwuo.', 'eciwx', 'ecowx', 'eieio', 'eqv',
+    'eqv.', 'extsb', 'extsb.', 'extsh', 'extsh.', 'fabs', 'fabs.', 'fadd',
+    'fadd.', 'fadds', 'fadds.', 'fcmpo', 'fcmpu', 'fctiw', 'fctiw.', 'fctiwz',
+    'fctiwz.', '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', 'mcrxr', 'mfcr', 'mffs', 'mffs.', 'mfmsr', 'mfspr', 'mfsr',
+    'mfsrin', 'mftb', 'mtcrf', 'mtfsb0', 'mtfsb1', 'mtfsf', 'mtfsf.',
+    'mtfsfi', 'mtfsfi.', 'mtmsr', 'mtspr', 'mtsr', 'mtsrin', 'mulhw',
+    'mulhw.', 'mulhwu', 'mulhwu.', 'mulli', 'mullw', 'mullw.', 'mullwo',
+    'mullwo.', 'nand', 'nand.', 'neg', 'neg.', 'nego', 'nego.', 'nor', 'nor.',
+    'or', 'or.', 'orc', 'orc.', 'ori', 'oris', 'rfi', 'rlwimi', 'rlwimi.',
+    'rlwinm', 'rlwinm.', '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', 'stwcx.', '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', 'mr.', 'not', 'mtcr',
+      'mtlr', 'mflr',
+    'mtctr', 'mfctr',
+    'extsw', 'rldimi',
+    'std', 'stdu', 'stdx', 'stdux',
+    'ld', 'ldu', 'ldx', 'ldux',
+    'cmpd', 'cmpdi', 'cmpld', 'cmpldi',
+    'srdi', 'sradi',
+    'sldi',
+    'rldicl',
+    'divdu', 'divd', 'mulld', 'srad', 'sld', 'srd',
+    'divduo.', 'divdo.',
+    'lwa', '<illegal lwau>', 'lwax', 'lwaux',
+    'fcfid',
+    'ldarx', 'stdcx.', 'cntlzd',
+    'lvx', 'stvx',
+    'mulldo', 'mulldo.', 'mulhdu', 'mulhdu.',
+    'mfxer');
+
+function gas_regnum_search(const s: string): Tregister;
+function gas_regname(r: Tregister): string;
+
+implementation
+
+uses
+  globtype, globals,
+  cutils, verbose, systems;
+
+const
+  gas_regname_table: array[tregisterindex] of string[7] = (
+{$I rppcgas.inc}
+    );
+
+  gas_regname_short_table: array[tregisterindex] of string[7] = (
+{$I rppcgss.inc}
+    );
+
+  gas_regname_index: array[tregisterindex] of tregisterindex = (
+{$I rppcgri.inc}
+    );
+
+function findreg_by_gasname(const s: string): tregisterindex;
+var
+  i, p: tregisterindex;
+begin
+  {Binary search.}
+  p := 0;
+  i := regnumber_count_bsstart;
+  repeat
+    if (p + i <= high(tregisterindex)) and (gas_regname_table[gas_regname_index[p
+      + i]] <= s) then
+      p := p + i;
+    i := i shr 1;
+  until i = 0;
+  if gas_regname_table[gas_regname_index[p]] = s then
+    findreg_by_gasname := gas_regname_index[p]
+  else
+    findreg_by_gasname := 0;
+end;
+
+function gas_regnum_search(const s: string): Tregister;
+begin
+  result := regnumber_table[findreg_by_gasname(s)];
+end;
+
+function gas_regname(r: Tregister): string;
+var
+  p: longint;
+begin
+  p := findreg_by_number(r);
+  if p <> 0 then
+    if (cs_create_smart in aktmoduleswitches) and
+      (target_info.system <> system_powerpc_darwin) then
+      result := gas_regname_short_table[p]
+    else
+      result := gas_regname_table[p]
+  else
+    result := generic_regname(r);
+end;
+
+end.
+

+ 851 - 0
compiler/powerpc64/nppcadd.pas

@@ -0,0 +1,851 @@
+{
+    Copyright (c) 2000-2002 by Florian Klaempfl and Jonas Maebe
+
+    Code generation for add nodes on the PowerPC64
+
+    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 nppcadd;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  node, nadd, ncgadd, cpubase;
+
+type
+  tppcaddnode = class(tcgaddnode)
+    function pass_1: tnode; override;
+    procedure pass_2; override;
+  private
+    procedure pass_left_and_right;
+    procedure load_left_right(cmpop, load_constants: boolean);
+    function getresflags: tresflags;
+    procedure emit_compare(unsigned: boolean);
+    procedure second_addfloat; override;
+    procedure second_addboolean; override;
+    procedure second_addsmallset; override;
+  end;
+
+implementation
+
+uses
+  sysutils,
+
+  globtype, systems,
+  cutils, verbose, globals,
+  symconst, symdef, paramgr,
+  aasmbase, aasmtai, aasmcpu, defutil, htypechk,
+  cgbase, cpuinfo, pass_1, pass_2, regvars,
+  cpupara, cgcpu, cgutils,
+  ncon, nset,
+  ncgutil, tgobj, rgobj, rgcpu, cgobj;
+
+{*****************************************************************************
+                                  Pass 1
+*****************************************************************************}
+
+function tppcaddnode.pass_1: tnode;
+begin
+  resulttypepass(left);
+  if (nodetype in [equaln, unequaln]) and
+    (left.resulttype.def.deftype = orddef) {and
+  is_64bit(left.resulttype.def)}then
+  begin
+    result := nil;
+    firstpass(left);
+    firstpass(right);
+    expectloc := LOC_FLAGS;
+    calcregisters(self, 2, 0, 0);
+    exit;
+  end;
+  result := inherited pass_1;
+end;
+
+{*****************************************************************************
+                                  Helpers
+*****************************************************************************}
+
+procedure tppcaddnode.pass_left_and_right;
+begin
+  { calculate the operator which is more difficult }
+  firstcomplex(self);
+
+  { in case of constant put it to the left }
+  if (left.nodetype = ordconstn) then
+    swapleftright;
+
+  secondpass(left);
+  secondpass(right);
+end;
+
+procedure tppcaddnode.load_left_right(cmpop, load_constants: boolean);
+
+  procedure load_node(var n: tnode);
+  begin
+    case n.location.loc of
+      LOC_REGISTER:
+        if not cmpop then
+        begin
+          location.register := n.location.register;
+        end;
+      LOC_REFERENCE, LOC_CREFERENCE:
+        begin
+          location_force_reg(exprasmlist, n.location,
+            def_cgsize(n.resulttype.def), false);
+          if not cmpop then
+          begin
+            location.register := n.location.register;
+          end;
+        end;
+      LOC_CONSTANT:
+        begin
+          if load_constants then
+          begin
+            location_force_reg(exprasmlist, n.location,
+              def_cgsize(n.resulttype.def), false);
+            if not cmpop then
+              location.register := n.location.register;
+          end;
+        end;
+    end;
+  end;
+
+begin
+  load_node(left);
+  load_node(right);
+  if not (cmpop) and
+    (location.register = NR_NO) then
+  begin
+    location.register := cg.getintregister(exprasmlist, OS_INT);
+  end;
+end;
+
+function tppcaddnode.getresflags: tresflags;
+begin
+  if (left.resulttype.def.deftype <> floatdef) then
+    result.cr := RS_CR0
+  else
+    result.cr := RS_CR1;
+  case nodetype of
+    equaln: result.flag := F_EQ;
+    unequaln: result.flag := F_NE;
+  else
+    if nf_swaped in flags then
+      case nodetype of
+        ltn: result.flag := F_GT;
+        lten: result.flag := F_GE;
+        gtn: result.flag := F_LT;
+        gten: result.flag := F_LE;
+      end
+    else
+      case nodetype of
+        ltn: result.flag := F_LT;
+        lten: result.flag := F_LE;
+        gtn: result.flag := F_GT;
+        gten: result.flag := F_GE;
+      end;
+  end
+end;
+
+// Todo: ts: allow emiting word compares...
+procedure tppcaddnode.emit_compare(unsigned: boolean);
+var
+  op: tasmop;
+  tmpreg: tregister;
+  useconst: boolean;
+begin
+  // get the constant on the right if there is one
+  if (left.location.loc = LOC_CONSTANT) then
+    swapleftright;
+  // can we use an immediate, or do we have to load the
+  // constant in a register first?
+  if (right.location.loc = LOC_CONSTANT) then
+  begin
+    if (nodetype in [equaln, unequaln]) then
+      if (unsigned and
+        (aword(right.location.value) > high(word))) or
+        (not unsigned and
+        (aint(right.location.value) < low(smallint)) or
+        (aint(right.location.value) > high(smallint))) then
+        { we can then maybe use a constant in the 'othersigned' case
+         (the sign doesn't matter for // equal/unequal)}
+        unsigned := not unsigned;
+
+    if (unsigned and
+      (aword(right.location.value) <= high(word))) or
+      (not (unsigned) and
+      (aint(right.location.value) >= low(smallint)) and
+      (aint(right.location.value) <= high(smallint))) then
+      useconst := true
+    else
+    begin
+      useconst := false;
+      tmpreg := cg.getintregister(exprasmlist, OS_INT);
+      cg.a_load_const_reg(exprasmlist, OS_INT,
+        right.location.value, tmpreg);
+    end
+  end
+  else
+    useconst := false;
+  location.loc := LOC_FLAGS;
+  location.resflags := getresflags;
+  if not unsigned then
+    if useconst then
+      op := A_CMPDI
+    else
+      op := A_CMPD
+  else if useconst then
+    op := A_CMPLDI
+  else
+    op := A_CMPLD;
+
+  if (right.location.loc = LOC_CONSTANT) then
+  begin
+    if useconst then
+      exprasmlist.concat(taicpu.op_reg_const(op, left.location.register,
+        longint(right.location.value)))
+    else
+      exprasmlist.concat(taicpu.op_reg_reg(op, left.location.register, tmpreg));
+  end
+  else
+    exprasmlist.concat(taicpu.op_reg_reg(op,
+      left.location.register, right.location.register));
+end;
+
+{*****************************************************************************
+                                AddBoolean
+*****************************************************************************}
+
+procedure tppcaddnode.second_addboolean;
+var
+  cgop: TOpCg;
+  cgsize: TCgSize;
+  cmpop,
+    isjump: boolean;
+  otl, ofl: tasmlabel;
+begin
+  { calculate the operator which is more difficult }
+  firstcomplex(self);
+
+  cmpop := false;
+  if (torddef(left.resulttype.def).typ = bool8bit) or
+    (torddef(right.resulttype.def).typ = bool8bit) then
+    cgsize := OS_8
+  else if (torddef(left.resulttype.def).typ = bool16bit) or
+    (torddef(right.resulttype.def).typ = bool16bit) then
+    cgsize := OS_16
+  else
+    cgsize := OS_32;
+
+  if (cs_full_boolean_eval in aktlocalswitches) or
+    (nodetype in [unequaln, ltn, lten, gtn, gten, equaln, xorn]) then
+  begin
+    if left.nodetype in [ordconstn, realconstn] then
+      swapleftright;
+
+    isjump := (left.expectloc = LOC_JUMP);
+    if isjump then
+    begin
+      otl := truelabel;
+      objectlibrary.getjumplabel(truelabel);
+      ofl := falselabel;
+      objectlibrary.getjumplabel(falselabel);
+    end;
+    secondpass(left);
+    if left.location.loc in [LOC_FLAGS, LOC_JUMP] then
+      location_force_reg(exprasmlist, left.location, cgsize, false);
+    if isjump then
+    begin
+      truelabel := otl;
+      falselabel := ofl;
+    end
+    else if left.location.loc = LOC_JUMP then
+      internalerror(2003122901);
+
+    isjump := (right.expectloc = LOC_JUMP);
+    if isjump then
+    begin
+      otl := truelabel;
+      objectlibrary.getjumplabel(truelabel);
+      ofl := falselabel;
+      objectlibrary.getjumplabel(falselabel);
+    end;
+    secondpass(right);
+    if right.location.loc in [LOC_FLAGS, LOC_JUMP] then
+      location_force_reg(exprasmlist, right.location, cgsize, false);
+    if isjump then
+    begin
+      truelabel := otl;
+      falselabel := ofl;
+    end
+    else if right.location.loc = LOC_JUMP then
+      internalerror(200312292);
+
+    cmpop := nodetype in [ltn, lten, gtn, gten, equaln, unequaln];
+
+    { set result location }
+    if not cmpop then
+      location_reset(location, LOC_REGISTER, def_cgsize(resulttype.def))
+    else
+      location_reset(location, LOC_FLAGS, OS_NO);
+
+    load_left_right(cmpop, false);
+
+    if (left.location.loc = LOC_CONSTANT) then
+      swapleftright;
+
+    { compare the }
+    case nodetype of
+      ltn, lten, gtn, gten,
+        equaln, unequaln:
+        begin
+          if (right.location.loc <> LOC_CONSTANT) then
+            exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,
+              left.location.register, right.location.register))
+          else
+            exprasmlist.concat(taicpu.op_reg_const(A_CMPLWI,
+              left.location.register, longint(right.location.value)));
+          location.resflags := getresflags;
+        end;
+    else
+      begin
+        case nodetype of
+          xorn:
+            cgop := OP_XOR;
+          orn:
+            cgop := OP_OR;
+          andn:
+            cgop := OP_AND;
+        else
+          internalerror(200203247);
+        end;
+
+        if right.location.loc <> LOC_CONSTANT then
+          cg.a_op_reg_reg_reg(exprasmlist, cgop, OS_INT,
+            left.location.register, right.location.register,
+            location.register)
+        else
+          cg.a_op_const_reg_reg(exprasmlist, cgop, OS_INT,
+            right.location.value, left.location.register,
+            location.register);
+      end;
+    end;
+  end
+  else
+  begin
+    // just to make sure we free the right registers
+    cmpop := true;
+    case nodetype of
+      andn,
+        orn:
+        begin
+          location_reset(location, LOC_JUMP, OS_NO);
+          case nodetype of
+            andn:
+              begin
+                otl := truelabel;
+                objectlibrary.getjumplabel(truelabel);
+                secondpass(left);
+                maketojumpbool(exprasmlist, left, lr_load_regvars);
+                cg.a_label(exprasmlist, truelabel);
+                truelabel := otl;
+              end;
+            orn:
+              begin
+                ofl := falselabel;
+                objectlibrary.getjumplabel(falselabel);
+                secondpass(left);
+                maketojumpbool(exprasmlist, left, lr_load_regvars);
+                cg.a_label(exprasmlist, falselabel);
+                falselabel := ofl;
+              end;
+          else
+            internalerror(200403181);
+          end;
+          secondpass(right);
+          maketojumpbool(exprasmlist, right, lr_load_regvars);
+        end;
+    end;
+  end;
+end;
+
+{*****************************************************************************
+                                AddFloat
+*****************************************************************************}
+
+procedure tppcaddnode.second_addfloat;
+var
+  op: TAsmOp;
+  cmpop: boolean;
+begin
+  pass_left_and_right;
+
+  cmpop := false;
+  case nodetype of
+    addn:
+      op := A_FADD;
+    muln:
+      op := A_FMUL;
+    subn:
+      op := A_FSUB;
+    slashn:
+      op := A_FDIV;
+    ltn, lten, gtn, gten,
+      equaln, unequaln:
+      begin
+        op := A_FCMPO;
+        cmpop := true;
+      end;
+  else
+    internalerror(200403182);
+  end;
+
+  // get the operands in the correct order, there are no special cases
+  // here, everything is register-based
+  if nf_swaped in flags then
+    swapleftright;
+
+  // put both operands in a register
+  location_force_fpureg(exprasmlist, right.location, true);
+  location_force_fpureg(exprasmlist, left.location, true);
+
+  // initialize de result
+  if not cmpop then
+  begin
+    location_reset(location, LOC_FPUREGISTER, def_cgsize(resulttype.def));
+    if left.location.loc = LOC_FPUREGISTER then
+      location.register := left.location.register
+    else if right.location.loc = LOC_FPUREGISTER then
+      location.register := right.location.register
+    else
+      location.register := cg.getfpuregister(exprasmlist, location.size);
+  end
+  else
+  begin
+    location_reset(location, LOC_FLAGS, OS_NO);
+    location.resflags := getresflags;
+  end;
+
+  // emit the actual operation
+  if not cmpop then
+  begin
+    exprasmlist.concat(taicpu.op_reg_reg_reg(op,
+      location.register, left.location.register,
+      right.location.register))
+  end
+  else
+  begin
+    exprasmlist.concat(taicpu.op_reg_reg_reg(op,
+      newreg(R_SPECIALREGISTER, location.resflags.cr, R_SUBNONE),
+        left.location.register, right.location.register))
+  end;
+end;
+
+{*****************************************************************************
+                                AddSmallSet
+*****************************************************************************}
+
+procedure tppcaddnode.second_addsmallset;
+var
+  cgop: TOpCg;
+  tmpreg: tregister;
+  opdone,
+    cmpop: boolean;
+
+  astring : string;
+  // ts: todo - speed up by using 32 bit compares/adds/ands here
+begin
+  pass_left_and_right;
+
+  { when a setdef is passed, it has to be a smallset }
+  if ((left.resulttype.def.deftype = setdef) and
+    (tsetdef(left.resulttype.def).settype <> smallset)) or
+    ((right.resulttype.def.deftype = setdef) and
+    (tsetdef(right.resulttype.def).settype <> smallset)) then
+    internalerror(200203301);
+
+  opdone := false;
+  cmpop := nodetype in [equaln, unequaln, lten, gten];
+
+  { set result location }
+  if not cmpop then
+    location_reset(location, LOC_REGISTER, def_cgsize(resulttype.def))
+  else
+    location_reset(location, LOC_FLAGS, OS_NO);
+
+  load_left_right(cmpop, false);
+
+  if not (cmpop) and
+    (location.register = NR_NO) then
+    location.register := cg.getintregister(exprasmlist, OS_64);
+
+  astring := 'addsmallset0 ' + inttostr(aword(1) shl aword(right.location.value)) + ' ' + inttostr(right.location.value);
+  exprasmlist.concat(tai_comment.create(strpnew(astring)));
+
+
+  case nodetype of
+    addn:
+      begin
+        if (nf_swaped in flags) and (left.nodetype = setelementn) then
+          swapleftright;
+        { are we adding set elements ? }
+        if right.nodetype = setelementn then begin
+          { no range support for smallsets! }
+          if assigned(tsetelementnode(right).right) then
+            internalerror(43244);
+          if (right.location.loc = LOC_CONSTANT) then begin
+
+            astring := 'addsmallset1 ' + inttostr(aword(1) shl aword(right.location.value)) + ' ' + inttostr(right.location.value);
+            exprasmlist.concat(tai_comment.create(strpnew(astring)));
+
+
+            cg.a_op_const_reg_reg(exprasmlist, OP_OR, OS_64,
+              aint(1) shl aint(right.location.value),
+              left.location.register, location.register)
+          end else
+          begin
+            tmpreg := cg.getintregister(exprasmlist, OS_64);
+            cg.a_load_const_reg(exprasmlist, OS_64, 1, tmpreg);
+            cg.a_op_reg_reg(exprasmlist, OP_SHL, OS_64,
+              right.location.register, tmpreg);
+            if left.location.loc <> LOC_CONSTANT then begin
+
+              cg.a_op_reg_reg_reg(exprasmlist, OP_OR, OS_64, tmpreg,
+                left.location.register, location.register)
+            end else begin
+              astring := 'addsmallset2 ' + inttostr(left.location.value);
+              exprasmlist.concat(tai_comment.create(strpnew(astring)));
+
+              cg.a_op_const_reg_reg(exprasmlist, OP_OR, OS_64,
+                left.location.value, tmpreg, location.register);
+            end;
+          end;
+          opdone := true;
+        end else begin
+          cgop := OP_OR;
+        end;
+      end;
+    symdifn:
+      cgop := OP_XOR;
+    muln:
+      cgop := OP_AND;
+    subn:
+      begin
+        cgop := OP_AND;
+        if (not (nf_swaped in flags)) then
+          if (right.location.loc = LOC_CONSTANT) then
+            right.location.value := not (right.location.value)
+          else
+            opdone := true
+        else if (left.location.loc = LOC_CONSTANT) then
+          left.location.value := not (left.location.value)
+        else begin
+          swapleftright;
+          opdone := true;
+        end;
+        if opdone then begin
+          if left.location.loc = LOC_CONSTANT then
+          begin
+            tmpreg := cg.getintregister(exprasmlist, OS_64);
+            cg.a_load_const_reg(exprasmlist, OS_64,
+              left.location.value, tmpreg);
+            exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC,
+              location.register, tmpreg, right.location.register));
+          end
+          else
+            exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC,
+              location.register, left.location.register,
+              right.location.register));
+        end;
+      end;
+    equaln,
+      unequaln:
+      begin
+        emit_compare(true);
+        opdone := true;
+      end;
+    lten, gten:
+      begin
+        if (not (nf_swaped in flags) and
+          (nodetype = lten)) or
+          ((nf_swaped in flags) and
+          (nodetype = gten)) then
+          swapleftright;
+        // now we have to check whether left >= right
+        tmpreg := cg.getintregister(exprasmlist, OS_64);
+        if left.location.loc = LOC_CONSTANT then begin
+          cg.a_op_const_reg_reg(exprasmlist, OP_AND, OS_64,
+            not (left.location.value), right.location.register, tmpreg);
+          exprasmlist.concat(taicpu.op_reg_const(A_CMPDI, tmpreg, 0));
+          // the two instructions above should be folded together by
+          // the peepholeoptimizer
+        end else begin
+          if right.location.loc = LOC_CONSTANT then begin
+            cg.a_load_const_reg(exprasmlist, OS_64,
+              right.location.value, tmpreg);
+            exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC_, tmpreg,
+              tmpreg, left.location.register));
+          end else
+            exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC_, tmpreg,
+              right.location.register, left.location.register));
+        end;
+        location.resflags.cr := RS_CR0;
+        location.resflags.flag := F_EQ;
+        opdone := true;
+      end;
+  else
+    internalerror(2002072701);
+  end;
+
+  if not opdone then begin
+    // these are all commutative operations
+    if (left.location.loc = LOC_CONSTANT) then
+      swapleftright;
+    if (right.location.loc = LOC_CONSTANT) then begin
+      astring := 'addsmallset4 ' + inttostr(right.location.value);
+      exprasmlist.concat(tai_comment.create(strpnew(astring)));
+
+      cg.a_op_const_reg_reg(exprasmlist, cgop, OS_64,
+        right.location.value, left.location.register,
+        location.register)
+    end else begin
+      cg.a_op_reg_reg_reg(exprasmlist, cgop, OS_64,
+        right.location.register, left.location.register,
+        location.register);
+    end;
+  end;
+end;
+
+{*****************************************************************************
+                                pass_2
+*****************************************************************************}
+
+procedure tppcaddnode.pass_2;
+{ is also being used for xor, and "mul", "sub, or and comparative }
+{ operators                                                }
+var
+  cgop: topcg;
+  op: tasmop;
+  tmpreg: tregister;
+  hl: tasmlabel;
+  cmpop: boolean;
+
+  { true, if unsigned types are compared }
+  unsigned: boolean;
+
+begin
+  { to make it more readable, string and set (not smallset!) have their
+    own procedures }
+  case left.resulttype.def.deftype of
+    orddef:
+      begin
+        { handling boolean expressions }
+        if is_boolean(left.resulttype.def) and
+          is_boolean(right.resulttype.def) then
+        begin
+          second_addboolean;
+          exit;
+        end;
+      end;
+    stringdef:
+      begin
+        internalerror(2002072402);
+        exit;
+      end;
+    setdef:
+      begin
+        { normalsets are already handled in pass1 }
+        if (tsetdef(left.resulttype.def).settype <> smallset) then
+          internalerror(200109041);
+        second_addsmallset;
+        exit;
+      end;
+    arraydef:
+      begin
+{$IFDEF SUPPORT_MMX}
+        if is_mmx_able_array(left.resulttype.def) then
+        begin
+          second_addmmx;
+          exit;
+        end;
+{$ENDIF SUPPORT_MMX}
+      end;
+    floatdef:
+      begin
+        second_addfloat;
+        exit;
+      end;
+  end;
+
+  { defaults }
+  cmpop := nodetype in [ltn, lten, gtn, gten, equaln, unequaln];
+  unsigned := not (is_signed(left.resulttype.def)) or
+    not (is_signed(right.resulttype.def));
+
+  pass_left_and_right;
+
+  { Convert flags to register first }
+  { can any of these things be in the flags actually?? (JM) }
+
+  if (left.location.loc = LOC_FLAGS) or
+    (right.location.loc = LOC_FLAGS) then
+    internalerror(2002072602);
+
+  { set result location }
+  if not cmpop then
+    location_reset(location, LOC_REGISTER, def_cgsize(resulttype.def))
+  else
+    location_reset(location, LOC_FLAGS, OS_NO);
+
+  load_left_right(cmpop, (cs_check_overflow in aktlocalswitches) and
+    (nodetype in [addn, subn, muln]));
+
+  if (location.register = NR_NO) and
+    not (cmpop) then
+    location.register := cg.getintregister(exprasmlist, OS_INT);
+
+  if not (cs_check_overflow in aktlocalswitches) or
+    (cmpop) or
+    (nodetype in [orn, andn, xorn]) then
+  begin
+    case nodetype of
+      addn, muln, xorn, orn, andn:
+        begin
+          case nodetype of
+            addn:
+              cgop := OP_ADD;
+            muln:
+              if unsigned then
+                cgop := OP_MUL
+              else
+                cgop := OP_IMUL;
+            xorn:
+              cgop := OP_XOR;
+            orn:
+              cgop := OP_OR;
+            andn:
+              cgop := OP_AND;
+          end;
+          if (left.location.loc = LOC_CONSTANT) then
+            swapleftright;
+          if (right.location.loc <> LOC_CONSTANT) then
+            cg.a_op_reg_reg_reg(exprasmlist, cgop, OS_INT,
+              left.location.register, right.location.register,
+              location.register)
+          else
+            cg.a_op_const_reg_reg(exprasmlist, cgop, OS_INT,
+              right.location.value, left.location.register,
+              location.register);
+        end;
+      subn:
+        begin
+          if (nf_swaped in flags) then
+            swapleftright;
+          if left.location.loc <> LOC_CONSTANT then
+            if right.location.loc <> LOC_CONSTANT then begin
+              cg.a_op_reg_reg_reg(exprasmlist, OP_SUB, OS_INT,
+                right.location.register, left.location.register,
+                location.register);
+            end else begin
+              cg.a_op_const_reg_reg(exprasmlist, OP_SUB, OS_INT,
+                right.location.value, left.location.register,
+                location.register);
+            end
+          else
+          begin
+            tmpreg := cg.getintregister(exprasmlist, OS_INT);
+            cg.a_load_const_reg(exprasmlist, OS_INT,
+              left.location.value, tmpreg);
+            cg.a_op_reg_reg_reg(exprasmlist, OP_SUB, OS_INT,
+              right.location.register, tmpreg, location.register);
+          end;
+        end;
+      ltn, lten, gtn, gten, equaln, unequaln:
+        begin
+          emit_compare(unsigned);
+        end;
+    end;
+  end
+  else
+    // overflow checking is on and we have an addn, subn or muln
+  begin
+    if is_signed(resulttype.def) then
+    begin
+      case nodetype of
+        addn:
+          op := A_ADDO;
+        subn:
+          begin
+            op := A_SUBO;
+            if (nf_swaped in flags) then
+              swapleftright;
+          end;
+        muln:
+          op := A_MULLDO;
+      else
+        internalerror(2002072601);
+      end;
+      exprasmlist.concat(taicpu.op_reg_reg_reg(op, location.register,
+        left.location.register, right.location.register));
+      cg.g_overflowcheck(exprasmlist, location, resulttype.def);
+    end
+    else
+    begin
+      case nodetype of
+        addn:
+          begin
+            exprasmlist.concat(taicpu.op_reg_reg_reg(A_ADD, location.register,
+              left.location.register, right.location.register));
+            exprasmlist.concat(taicpu.op_reg_reg(A_CMPLD, location.register,
+              left.location.register));
+            cg.g_overflowcheck(exprasmlist, location, resulttype.def);
+          end;
+        subn:
+          begin
+            exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUB, location.register,
+              left.location.register, right.location.register));
+            exprasmlist.concat(taicpu.op_reg_reg(A_CMPLD,
+              left.location.register, location.register));
+            cg.g_overflowcheck(exprasmlist, location, resulttype.def);
+          end;
+        muln:
+          begin
+            { calculate the upper 64 bits of the product, = 0 if no overflow }
+            cg.a_reg_alloc(exprasmlist, NR_R0);
+            exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULHDU_, NR_R0,
+              left.location.register, right.location.register));
+            cg.a_reg_dealloc(exprasmlist, NR_R0);
+            { calculate the real result }
+            exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULLD, location.register,
+              left.location.register, right.location.register));
+            { g_overflowcheck generates a OC_AE instead of OC_EQ :/ }
+            objectlibrary.getjumplabel(hl);
+            tcgppc(cg).a_jmp_cond(exprasmlist, OC_EQ, hl);
+            cg.a_call_name(exprasmlist, 'FPC_OVERFLOW');
+            cg.a_label(exprasmlist, hl);
+          end;
+      end;
+    end;
+  end;
+end;
+
+begin
+  caddnode := tppcaddnode;
+end.
+

+ 55 - 0
compiler/powerpc64/nppccal.pas

@@ -0,0 +1,55 @@
+{
+    Copyright (c) 2002 by Florian Klaempfl
+
+    Implements the PowerPC specific part of call nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published bymethodpointer
+    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 nppccal;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  symdef, node, ncal, ncgcal;
+
+type
+  tppccallnode = class(tcgcallnode)
+  end;
+
+implementation
+
+uses
+  globtype, systems,
+  cutils, verbose, globals,
+  symconst, symbase, symsym, symtable, defutil, paramgr, parabase,
+{$IFDEF GDB}
+  strings,
+  gdb,
+{$ENDIF GDB}
+  cgbase, pass_2,
+  cpuinfo, cpubase, aasmbase, aasmtai, aasmcpu,
+  nmem, nld, ncnv,
+  ncgutil, cgutils, cgobj, tgobj, regvars, rgobj, rgcpu,
+  cgcpu, cpupi, procinfo;
+
+
+begin
+  ccallnode := tppccallnode;
+end.
+

+ 309 - 0
compiler/powerpc64/nppccnv.pas

@@ -0,0 +1,309 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate PowerPC assembler for type converting nodes
+
+    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 nppccnv;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  node, ncnv, ncgcnv, defcmp;
+
+type
+  tppctypeconvnode = class(tcgtypeconvnode)
+  protected
+    { procedure second_int_to_int;override; }
+    { procedure second_string_to_string;override; }
+    { procedure second_cstring_to_pchar;override; }
+    { procedure second_string_to_chararray;override; }
+    { procedure second_array_to_pointer;override; }
+    function first_int_to_real: tnode; override;
+    { procedure second_pointer_to_array;override; }
+    { procedure second_chararray_to_string;override; }
+    { procedure second_char_to_string;override; }
+    procedure second_int_to_real; override;
+    { procedure second_real_to_real; override;}
+    { procedure second_cord_to_pointer;override; }
+    { procedure second_proc_to_procvar;override; }
+    { procedure second_bool_to_int;override; }
+    procedure second_int_to_bool; override;
+    { procedure second_load_smallset;override;  }
+    { procedure second_ansistring_to_pchar;override; }
+    { procedure second_pchar_to_string;override; }
+    { procedure second_class_to_intf;override; }
+    { procedure second_char_to_char;override; }
+  end;
+
+implementation
+
+uses
+  verbose, globtype, globals, systems,
+  symconst, symdef, aasmbase, aasmtai,
+  defutil,
+  cgbase, cgutils, pass_1, pass_2,
+  ncon, ncal,
+  ncgutil,
+  cpubase, aasmcpu,
+  rgobj, tgobj, cgobj;
+
+{*****************************************************************************
+                             FirstTypeConv
+*****************************************************************************}
+
+function tppctypeconvnode.first_int_to_real: tnode;
+begin
+  if (is_currency(left.resulttype.def)) then begin
+    // hack to avoid double division by 10000, as it's
+    // already done by resulttypepass.resulttype_int_to_real
+    left.resulttype := s64inttype;
+  end else begin
+    // everything that is less than 64 bits is converted to a 64 bit signed
+    // integer - because the int_to_real conversion is faster for 64 bit
+    // signed ints compared to 64 bit unsigned ints.
+    if (not (torddef(left.resulttype.def).typ in [s64bit, u64bit])) then begin
+      inserttypeconv(left, s64inttype);
+    end;
+  end;
+  firstpass(left);
+  result := nil;
+  if registersfpu < 1 then
+    registersfpu := 1;
+  expectloc := LOC_FPUREGISTER;
+end;
+
+{*****************************************************************************
+                             SecondTypeConv
+*****************************************************************************}
+
+procedure tppctypeconvnode.second_int_to_real;
+const
+  convconst : double = $100000000;
+var
+  tempconst : trealconstnode;
+  disp, disp2: treference;
+  // temp registers for converting signed ints
+  valuereg, leftreg,
+  // additional temp registers for converting unsigned 64 bit ints
+  tmpintreg1, tmpintreg2, tmpfpureg, tmpfpuconst : tregister;
+  size: tcgsize;
+  signed: boolean;
+begin
+
+  location_reset(location, LOC_FPUREGISTER, def_cgsize(resulttype.def));
+
+  { the code here comes from the PowerPC Compiler Writer's Guide }
+  { * longint to double (works for all rounding modes) }
+  { std   R3,disp(R1) # store doubleword }
+  { lfd   FR1,disp(R1) # load float double }
+  { fcfid FR1,FR1 # convert to floating-point integer  }
+
+  { * unsigned 64 bit int to fp value (works for all rounding modes) }
+  { rldicl rT1,rS,32,32 # isolate high half }
+  { rldicl rT2,rS,0,32 # isolate low half }
+  { std rT1,disp(R1) # store high half }
+  { std rT2,disp+8(R1) # store low half }
+  { lfd frT1,disp(R1) # load high half }
+  { lfd frD,disp+8(R1) # load low half }
+  { fcfid frT1,frT1 # convert each half to floating }
+  { fcfid frD,frD # point integer (no round) }
+  { fmadd frD,frC,frT1,frD # (2^32)*high + low }
+  { # (only add can round) }
+  tg.Gettemp(exprasmlist, 8, tt_normal, disp);
+
+  { do the signed case for everything but 64 bit unsigned integers }
+  signed := (left.location.size <> OS_64);
+
+  { we need a certain constant for the conversion of unsigned 64 bit integers,
+    so create them here. Additonally another temporary location is neeted }
+  if (not signed) then begin
+    // allocate temp for constant value used for unsigned 64 bit ints
+    tempconst :=
+      crealconstnode.create(convconst, pbestrealtype^);
+    resulttypepass(tempconst);
+    firstpass(tempconst);
+    secondpass(tempconst);
+    if (tempconst.location.loc <> LOC_CREFERENCE) then
+      internalerror(200110011);
+
+    // allocate second temp memory
+    tg.Gettemp(exprasmlist, 8, tt_normal, disp2);
+  end;
+
+  case left.location.loc of
+    LOC_REGISTER:
+      begin
+        leftreg := left.location.register;
+        valuereg := leftreg;
+      end;
+    LOC_CREGISTER:
+      begin
+        leftreg := left.location.register;
+        if signed then
+          valuereg := cg.getintregister(exprasmlist, OS_INT)
+        else
+          valuereg := leftreg;
+      end;
+    LOC_REFERENCE, LOC_CREFERENCE:
+      begin
+        leftreg := cg.getintregister(exprasmlist, OS_INT);
+        valuereg := leftreg;
+        if signed then
+          size := OS_S64
+        else
+          size := OS_64;
+        cg.a_load_ref_reg(exprasmlist, def_cgsize(left.resulttype.def),
+          size, left.location.reference, leftreg);
+      end
+  else
+    internalerror(200110012);
+  end;
+
+  if (signed) then begin
+    // std rS, disp(r1)
+    cg.a_load_reg_ref(exprasmlist, OS_S64, OS_S64, valuereg, disp);
+    // lfd frD, disp(r1)
+    location.register := cg.getfpuregister(exprasmlist,OS_F64);
+    cg.a_loadfpu_ref_reg(exprasmlist,OS_F64, disp, location.register);
+    // fcfid frD, frD
+    exprasmlist.concat(taicpu.op_reg_reg(A_FCFID, location.register,
+      location.register));
+  end else begin
+    { ts:todo use TOC for this constant or at least schedule better }
+    // lfd frC, const
+    tmpfpuconst := cg.getfpuregister(exprasmlist,OS_F64);
+    cg.a_loadfpu_ref_reg(exprasmlist,OS_F64,tempconst.location.reference,
+      tmpfpuconst);
+    tempconst.free;
+
+    tmpintreg1 := cg.getintregister(exprasmlist, OS_64);
+    // rldicl rT1, rS, 32, 32
+    exprasmlist.concat(taicpu.op_reg_reg_const_const(A_RLDICL, tmpintreg1, valuereg, 32, 32));
+    // rldicl rT2, rS, 0, 32
+    tmpintreg2 := cg.getintregister(exprasmlist, OS_64);
+    exprasmlist.concat(taicpu.op_reg_reg_const_const(A_RLDICL, tmpintreg2, valuereg, 0, 32));
+
+    // std rT1, disp(r1)
+    cg.a_load_reg_ref(exprasmlist, OS_S64, OS_S64, tmpintreg1, disp);
+    // std rT2, disp2(r1)
+    cg.a_load_reg_ref(exprasmlist, OS_S64, OS_S64, tmpintreg2, disp2);
+
+    // lfd frT1, disp(R1)
+    tmpfpureg := cg.getfpuregister(exprasmlist,OS_F64);
+    cg.a_loadfpu_ref_reg(exprasmlist,OS_F64, disp, tmpfpureg);
+    // lfd frD, disp+8(R1)
+    location.register := cg.getfpuregister(exprasmlist,OS_F64);
+    cg.a_loadfpu_ref_reg(exprasmlist,OS_F64, disp2, location.register);
+
+    // fcfid frT1, frT1
+    exprasmlist.concat(taicpu.op_reg_reg(A_FCFID, tmpfpureg,
+      tmpfpureg));
+    // fcfid frD, frD
+    exprasmlist.concat(taicpu.op_reg_reg(A_FCFID, location.register,
+      location.register));
+    // fmadd frD,frC,frT1,frD # (2^32)*high + low }
+    exprasmlist.concat(taicpu.op_reg_reg_reg_reg(A_FMADD, location.register, tmpfpuconst,
+      tmpfpureg, location.register));
+
+    // free used temps
+    tg.ungetiftemp(exprasmlist, disp2);
+  end;
+  // free reference
+  tg.ungetiftemp(exprasmlist, disp);
+
+end;
+
+procedure tppctypeconvnode.second_int_to_bool;
+var
+  hreg1,
+    hreg2: tregister;
+  resflags: tresflags;
+  opsize: tcgsize;
+  hlabel, oldtruelabel, oldfalselabel: tasmlabel;
+begin
+  oldtruelabel := truelabel;
+  oldfalselabel := falselabel;
+  objectlibrary.getjumplabel(truelabel);
+  objectlibrary.getjumplabel(falselabel);
+  secondpass(left);
+  if codegenerror then
+    exit;
+
+  { byte(boolean) or word(wordbool) or longint(longbool) must }
+  { be accepted for var parameters                            }
+  if (nf_explicit in flags) and
+    (left.resulttype.def.size = resulttype.def.size) and
+    (left.location.loc in [LOC_REFERENCE, LOC_CREFERENCE, LOC_CREGISTER]) then
+  begin
+    truelabel := oldtruelabel;
+    falselabel := oldfalselabel;
+    location_copy(location, left.location);
+    exit;
+  end;
+
+  location_reset(location, LOC_REGISTER, def_cgsize(resulttype.def));
+  opsize := def_cgsize(left.resulttype.def);
+  case left.location.loc of
+    LOC_CREFERENCE, LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER:
+      begin
+        if left.location.loc in [LOC_CREFERENCE, LOC_REFERENCE] then
+        begin
+          hreg1 := cg.getintregister(exprasmlist, OS_INT);
+          cg.a_load_ref_reg(exprasmlist, opsize, opsize,
+            left.location.reference, hreg1);
+        end
+        else
+        begin
+          hreg1 := left.location.register;
+        end;
+        hreg2 := cg.getintregister(exprasmlist, OS_INT);
+        exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBIC, hreg2, hreg1, 1));
+        exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE, hreg1, hreg2, hreg1));
+      end;
+    LOC_FLAGS:
+      begin
+        hreg1 := cg.getintregister(exprasmlist, OS_INT);
+        resflags := left.location.resflags;
+        cg.g_flags2reg(exprasmlist, location.size, resflags, hreg1);
+      end;
+    LOC_JUMP:
+      begin
+        hreg1 := cg.getintregister(exprasmlist, OS_INT);
+        objectlibrary.getjumplabel(hlabel);
+        cg.a_label(exprasmlist, truelabel);
+        cg.a_load_const_reg(exprasmlist, OS_INT, 1, hreg1);
+        cg.a_jmp_always(exprasmlist, hlabel);
+        cg.a_label(exprasmlist, falselabel);
+        cg.a_load_const_reg(exprasmlist, OS_INT, 0, hreg1);
+        cg.a_label(exprasmlist, hlabel);
+      end;
+  else
+    internalerror(10062);
+  end;
+  location.register := hreg1;
+  truelabel := oldtruelabel;
+  falselabel := oldfalselabel;
+end;
+
+begin
+  ctypeconvnode := tppctypeconvnode;
+end.
+

+ 148 - 0
compiler/powerpc64/nppcinl.pas

@@ -0,0 +1,148 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate i386 inline nodes
+
+    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 nppcinl;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  node, ninl, ncginl;
+
+type
+  tppcinlinenode = class(tcginlinenode)
+    { first pass override
+      so that the code generator will actually generate
+      these nodes.
+    }
+    function first_abs_real: tnode; override;
+    function first_sqr_real: tnode; override;
+    procedure second_abs_real; override;
+    procedure second_sqr_real; override;
+    procedure second_prefetch; override;
+  private
+    procedure load_fpu_location;
+  end;
+
+implementation
+
+uses
+  cutils, globals, verbose,
+  aasmtai, aasmcpu,
+  symconst, symdef,
+  defutil,
+  cgbase, pass_2,
+  cpubase, ncgutil,
+  cgutils, cgobj, rgobj;
+
+{*****************************************************************************
+                              TPPCINLINENODE
+*****************************************************************************}
+
+function tppcinlinenode.first_abs_real: tnode;
+begin
+  expectloc := LOC_FPUREGISTER;
+  registersint := left.registersint;
+  registersfpu := max(left.registersfpu, 1);
+{$IFDEF SUPPORT_MMX}
+  registersmmx := left.registersmmx;
+{$ENDIF SUPPORT_MMX}
+  first_abs_real := nil;
+end;
+
+function tppcinlinenode.first_sqr_real: tnode;
+begin
+  expectloc := LOC_FPUREGISTER;
+  registersint := left.registersint;
+  registersfpu := max(left.registersfpu, 1);
+{$IFDEF SUPPORT_MMX}
+  registersmmx := left.registersmmx;
+{$ENDIF SUPPORT_MMX}
+  first_sqr_real := nil;
+end;
+
+{ load the FPU into the an fpu register }
+
+procedure tppcinlinenode.load_fpu_location;
+begin
+  location_reset(location, LOC_FPUREGISTER, def_cgsize(resulttype.def));
+  secondpass(left);
+  location_force_fpureg(exprasmlist, left.location, true);
+  location_copy(location, left.location);
+  if (location.loc = LOC_CFPUREGISTER) then
+  begin
+    location.loc := LOC_FPUREGISTER;
+    location.register := cg.getfpuregister(exprasmlist, OS_F64);
+  end;
+end;
+
+procedure tppcinlinenode.second_abs_real;
+begin
+  location.loc := LOC_FPUREGISTER;
+  load_fpu_location;
+  exprasmlist.concat(taicpu.op_reg_reg(A_FABS, location.register,
+    left.location.register));
+end;
+
+procedure tppcinlinenode.second_sqr_real;
+begin
+  location.loc := LOC_FPUREGISTER;
+  load_fpu_location;
+  exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMUL, location.register,
+    left.location.register, left.location.register));
+end;
+
+procedure tppcinlinenode.second_prefetch;
+var
+  r: tregister;
+begin
+  secondpass(left);
+  case left.location.loc of
+    LOC_CREFERENCE,
+      LOC_REFERENCE:
+      begin
+        r := cg.getintregister(exprasmlist, OS_ADDR);
+        if (left.location.reference.offset = 0) and
+          not assigned(left.location.reference.symbol) then
+        begin
+          if (left.location.reference.index = NR_NO) then
+            exprasmlist.concat(taicpu.op_const_reg(A_DCBT, 0,
+              left.location.reference.base))
+          else
+            exprasmlist.concat(taicpu.op_reg_reg(A_DCBT,
+              left.location.reference.base, left.location.reference.index));
+        end
+        else
+        begin
+          cg.a_loadaddr_ref_reg(exprasmlist, left.location.reference, r);
+          exprasmlist.concat(taicpu.op_const_reg(A_DCBT, 0, r));
+        end;
+      end;
+  else
+    internalerror(200402021);
+  end;
+end;
+
+begin
+  cinlinenode := tppcinlinenode;
+end.
+

+ 62 - 0
compiler/powerpc64/nppcld.pas

@@ -0,0 +1,62 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate ppc assembler for nodes that handle loads and assignments
+
+    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 nppcld;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  node, ncgld;
+
+type
+  tppcloadnode = class(tcgloadnode)
+    procedure pass_2; override;
+    procedure generate_picvaraccess; override;
+  end;
+
+implementation
+
+uses
+  verbose,
+  systems,
+  cpubase,
+  cgutils, cgobj,
+  aasmbase, aasmtai,
+  symconst, symsym,
+  procinfo,
+  nld;
+
+procedure tppcloadnode.pass_2;
+begin
+  inherited pass_2;
+end;
+
+procedure tppcloadnode.generate_picvaraccess;
+begin
+  internalerror(200402291);
+end;
+
+begin
+  cloadnode := tppcloadnode;
+end.
+

+ 373 - 0
compiler/powerpc64/nppcmat.pas

@@ -0,0 +1,373 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Generate PowerPC assembler for math nodes
+
+    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 nppcmat;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  node, nmat;
+
+type
+  tppcmoddivnode = class(tmoddivnode)
+    function pass_1: tnode; override;
+    procedure pass_2; override;
+  end;
+
+  tppcshlshrnode = class(tshlshrnode)
+    procedure pass_2; override;
+  end;
+
+  tppcunaryminusnode = class(tunaryminusnode)
+    procedure pass_2; override;
+  end;
+
+  tppcnotnode = class(tnotnode)
+    procedure pass_2; override;
+  end;
+
+implementation
+
+uses
+  globtype, systems,
+  cutils, verbose, globals,
+  symconst, symdef,
+  aasmbase, aasmcpu, aasmtai,
+  defutil,
+  cgbase, cgutils, cgobj, pass_1, pass_2,
+  ncon, procinfo,
+  cpubase, cpuinfo,
+  ncgutil, cgcpu, rgobj;
+
+{*****************************************************************************
+                             TPPCMODDIVNODE
+*****************************************************************************}
+
+function tppcmoddivnode.pass_1: tnode;
+begin
+  result := inherited pass_1;
+  if not assigned(result) then
+    include(current_procinfo.flags, pi_do_call);
+end;
+
+procedure tppcmoddivnode.pass_2;
+const
+  // ts: todo, use 32 bit operations if possible (much faster!)
+  { signed   overflow }
+  divops: array[boolean, boolean] of tasmop =
+  ((A_DIVDU, A_DIVDUO_), (A_DIVD, A_DIVDO_));
+  zerocond: tasmcond = (dirhint: DH_Plus; simple: true; cond: C_NE; cr: RS_CR1);
+var
+  power: longint;
+  op: tasmop;
+  numerator,
+    divider,
+    resultreg: tregister;
+  size: Tcgsize;
+  hl: tasmlabel;
+
+begin
+  secondpass(left);
+  secondpass(right);
+  location_copy(location, left.location);
+
+  { put numerator in register }
+  size := def_cgsize(left.resulttype.def);
+  location_force_reg(exprasmlist, left.location,
+    size, true);
+  location_copy(location, left.location);
+  numerator := location.register;
+  resultreg := location.register;
+  if (location.loc = LOC_CREGISTER) then
+  begin
+    location.loc := LOC_REGISTER;
+    location.register := cg.getintregister(exprasmlist, size);
+    resultreg := location.register;
+  end;
+  if (nodetype = modn) then
+  begin
+    resultreg := cg.getintregister(exprasmlist, size);
+  end;
+
+  if (nodetype = divn) and
+    (right.nodetype = ordconstn) and
+    ispowerof2(tordconstnode(right).value, power) then
+  begin
+    { From "The PowerPC Compiler Writer's Guide":                   }
+    { This code uses the fact that, in the PowerPC architecture,    }
+    { the shift right algebraic instructions set the Carry bit if   }
+    { the source register contains a negative number and one or     }
+    { more 1-bits are shifted out. Otherwise, the carry bit is      }
+    { cleared. The addze instruction corrects the quotient, if      }
+    { necessary, when the dividend is negative. For example, if     }
+    { n = -13, (0xFFFF_FFF3), and k = 2, after executing the srawi  }
+    { instruction, q = -4 (0xFFFF_FFFC) and CA = 1. After executing }
+    { the addze instruction, q = -3, the correct quotient.          }
+    // ts: buggy....... sar also used in a unsigned division...
+    cg.a_op_const_reg_reg(exprasmlist, OP_SAR, OS_64, power,
+      numerator, resultreg);
+    exprasmlist.concat(taicpu.op_reg_reg(A_ADDZE, resultreg, resultreg));
+  end
+  else
+  begin
+    { load divider in a register if necessary }
+    location_force_reg(exprasmlist, right.location,
+      def_cgsize(right.resulttype.def), true);
+    if (right.nodetype <> ordconstn) then
+{$NOTE ts: testme}
+      exprasmlist.concat(taicpu.op_reg_reg_const(A_CMPDI, NR_CR1,
+        right.location.register, 0));
+    divider := right.location.register;
+
+    { needs overflow checking, (-maxlongint-1) div (-1) overflows! }
+    { And on PPC, the only way to catch a div-by-0 is by checking  }
+    { the overflow flag (JM)                                       }
+    op := divops[is_signed(right.resulttype.def),
+      cs_check_overflow in aktlocalswitches];
+    exprasmlist.concat(taicpu.op_reg_reg_reg(op, resultreg, numerator,
+      divider));
+
+    if (nodetype = modn) then
+    begin
+{$NOTE ts:testme}
+      exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULLD, resultreg,
+        divider, resultreg));
+      exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUB, location.register,
+        numerator, resultreg));
+      resultreg := location.register;
+    end;
+  end;
+  { set result location }
+  location.loc := LOC_REGISTER;
+  location.register := resultreg;
+  if right.nodetype <> ordconstn then
+  begin
+    objectlibrary.getjumplabel(hl);
+    exprasmlist.concat(taicpu.op_cond_sym(A_BC, zerocond, hl));
+    cg.a_call_name(exprasmlist, 'FPC_DIVBYZERO');
+    cg.a_label(exprasmlist, hl);
+  end;
+  cg.g_overflowcheck(exprasmlist, location, resulttype.def);
+end;
+
+{*****************************************************************************
+                             TPPCSHLRSHRNODE
+*****************************************************************************}
+
+
+procedure tppcshlshrnode.pass_2;
+
+var
+  resultreg, hregister1, hregister2,
+    hreg64hi, hreg64lo: tregister;
+  op: topcg;
+  asmop1, asmop2: tasmop;
+  shiftval: aint;
+
+begin
+  secondpass(left);
+  secondpass(right);
+
+  { load left operators in a register }
+  location_force_reg(exprasmlist, left.location,
+    def_cgsize(left.resulttype.def), true);
+  location_copy(location, left.location);
+  resultreg := location.register;
+  hregister1 := location.register;
+  if (location.loc = LOC_CREGISTER) then begin
+    location.loc := LOC_REGISTER;
+    resultreg := cg.getintregister(exprasmlist, OS_64);
+    location.register := resultreg;
+  end;
+
+  { determine operator }
+  if nodetype = shln then
+    op := OP_SHL
+  else
+    op := OP_SHR;
+
+  { shifting by a constant directly coded: }
+  if (right.nodetype = ordconstn) then begin
+    // result types with size < 32 bits have their shift values masked
+    // differently... :/
+    shiftval := tordconstnode(right).value and (tcgsize2size[def_cgsize(resulttype.def)] * 8 -1);
+    cg.a_op_const_reg_reg(exprasmlist, op, def_cgsize(resulttype.def),
+      shiftval, hregister1, resultreg)
+  end else begin
+    { load shift count in a register if necessary }
+    location_force_reg(exprasmlist, right.location,
+      def_cgsize(right.resulttype.def), true);
+    hregister2 := right.location.register;
+    cg.a_op_reg_reg_reg(exprasmlist, op, def_cgsize(resulttype.def), hregister2,
+      hregister1, resultreg);
+  end;
+end;
+
+{*****************************************************************************
+                          TPPCUNARYMINUSNODE
+*****************************************************************************}
+
+procedure tppcunaryminusnode.pass_2;
+
+var
+  src1: tregister;
+  op: tasmop;
+
+begin
+  secondpass(left);
+  begin
+    location_copy(location, left.location);
+    location.loc := LOC_REGISTER;
+    case left.location.loc of
+      LOC_FPUREGISTER, LOC_REGISTER:
+        begin
+          src1 := left.location.register;
+          location.register := src1;
+        end;
+      LOC_CFPUREGISTER, LOC_CREGISTER:
+        begin
+          src1 := left.location.register;
+          if left.location.loc = LOC_CREGISTER then
+            location.register := cg.getintregister(exprasmlist, OS_INT)
+          else
+            location.register := cg.getfpuregister(exprasmlist, location.size);
+        end;
+      LOC_REFERENCE, LOC_CREFERENCE:
+        begin
+          if (left.resulttype.def.deftype = floatdef) then
+          begin
+            src1 := cg.getfpuregister(exprasmlist,
+              def_cgsize(left.resulttype.def));
+            location.register := src1;
+            cg.a_loadfpu_ref_reg(exprasmlist,
+              def_cgsize(left.resulttype.def),
+              left.location.reference, src1);
+          end
+          else
+          begin
+            src1 := cg.getintregister(exprasmlist, OS_64);
+            location.register := src1;
+            cg.a_load_ref_reg(exprasmlist, OS_64, OS_64,
+              left.location.reference, src1);
+          end;
+        end;
+    end;
+    { choose appropriate operand }
+    if left.resulttype.def.deftype <> floatdef then
+    begin
+      if not (cs_check_overflow in aktlocalswitches) then
+        op := A_NEG
+      else
+        op := A_NEGO_;
+      location.loc := LOC_REGISTER;
+    end
+    else
+    begin
+      op := A_FNEG;
+      location.loc := LOC_FPUREGISTER;
+    end;
+    { emit operation }
+    exprasmlist.concat(taicpu.op_reg_reg(op, location.register, src1));
+  end;
+  { Here was a problem...     }
+  { Operand to be negated always     }
+  { seems to be converted to signed  }
+  { 32-bit before doing neg!!     }
+  { So this is useless...     }
+  { that's not true: -2^31 gives an overflow error if it is negated (FK) }
+  cg.g_overflowcheck(exprasmlist, location, resulttype.def);
+end;
+
+{*****************************************************************************
+                               TPPCNOTNODE
+*****************************************************************************}
+
+procedure tppcnotnode.pass_2;
+
+var
+  hl: tasmlabel;
+
+begin
+  if is_boolean(resulttype.def) then
+  begin
+    { if the location is LOC_JUMP, we do the secondpass after the
+      labels are allocated
+    }
+    if left.expectloc = LOC_JUMP then
+    begin
+      hl := truelabel;
+      truelabel := falselabel;
+      falselabel := hl;
+      secondpass(left);
+      maketojumpbool(exprasmlist, left, lr_load_regvars);
+      hl := truelabel;
+      truelabel := falselabel;
+      falselabel := hl;
+      location.loc := LOC_JUMP;
+    end
+    else
+    begin
+      secondpass(left);
+      case left.location.loc of
+        LOC_FLAGS:
+          begin
+            location_copy(location, left.location);
+            inverse_flags(location.resflags);
+          end;
+        LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_CREFERENCE:
+          begin
+            location_force_reg(exprasmlist, left.location,
+              def_cgsize(left.resulttype.def), true);
+            exprasmlist.concat(taicpu.op_reg_const(A_CMPDI,
+              left.location.register, 0));
+            location_reset(location, LOC_FLAGS, OS_NO);
+            location.resflags.cr := RS_CR0;
+            location.resflags.flag := F_EQ;
+          end;
+      else
+        internalerror(2003042401);
+      end;
+    end;
+  end
+  else
+  begin
+    secondpass(left);
+    location_force_reg(exprasmlist, left.location,
+      def_cgsize(left.resulttype.def), true);
+    location_copy(location, left.location);
+    location.loc := LOC_REGISTER;
+    location.register := cg.getintregister(exprasmlist, OS_INT);
+    { perform the NOT operation }
+    cg.a_op_reg_reg(exprasmlist, OP_NOT, def_cgsize(resulttype.def),
+      left.location.register,
+      location.register);
+  end;
+end;
+
+begin
+  cmoddivnode := tppcmoddivnode;
+  cshlshrnode := tppcshlshrnode;
+  cunaryminusnode := tppcunaryminusnode;
+  cnotnode := tppcnotnode;
+end.
+

+ 149 - 0
compiler/powerpc64/nppcset.pas

@@ -0,0 +1,149 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere
+
+    Generate PowerPC assembler for in set/case nodes
+
+    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 nppcset;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  node, nset, ncgset, cpubase, cgbase, cgobj, aasmbase, aasmtai;
+
+type
+
+  tppccasenode = class(tcgcasenode)
+  protected
+    procedure genlinearlist(hp: pcaselabel); override;
+  end;
+
+implementation
+
+uses
+  globtype, systems,
+  verbose, globals,
+  symconst, symdef, defutil,
+  paramgr,
+  cpuinfo,
+  pass_2, cgcpu,
+  ncon,
+  tgobj, ncgutil, regvars, rgobj, aasmcpu;
+
+{*****************************************************************************
+                            TCGCASENODE
+*****************************************************************************}
+
+procedure tppccasenode.genlinearlist(hp: pcaselabel);
+
+var
+  first, lastrange: boolean;
+  last: TConstExprInt;
+
+  procedure genitem(t: pcaselabel);
+
+    procedure gensub(value: aint);
+    var
+      tmpreg: tregister;
+    begin
+      value := -value;
+      if (value >= low(smallint)) and
+        (value <= high(smallint)) then
+        exprasmlist.concat(taicpu.op_reg_reg_const(A_ADDIC_, hregister,
+          hregister, value))
+      else
+      begin
+        tmpreg := cg.getintregister(exprasmlist, OS_INT);
+        cg.a_load_const_reg(exprasmlist, OS_INT, value, tmpreg);
+        exprasmlist.concat(taicpu.op_reg_reg_reg(A_ADD_, hregister,
+          hregister, tmpreg));
+      end;
+    end;
+
+  begin
+    if assigned(t^.less) then
+      genitem(t^.less);
+    { need we to test the first value }
+    if first and (t^._low > get_min_value(left.resulttype.def)) then
+    begin
+      cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, aword(t^._low),
+        hregister, elselabel);
+    end;
+    if t^._low = t^._high then
+    begin
+      if t^._low - last = 0 then
+        cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ, 0, hregister,
+          blocklabel(t^.blockid))
+      else
+        gensub(aint(t^._low - last));
+      tcgppc(cg).a_jmp_cond(exprasmlist, OC_EQ, blocklabel(t^.blockid));
+      last := t^._low;
+      lastrange := false;
+    end
+    else
+    begin
+      { it begins with the smallest label, if the value }
+      { is even smaller then jump immediately to the    }
+      { ELSE-label                                }
+      if first then
+      begin
+        { have we to ajust the first value ? }
+        if (t^._low > get_min_value(left.resulttype.def)) then
+          gensub(aint(t^._low));
+      end
+      else
+      begin
+        { if there is no unused label between the last and the }
+        { present label then the lower limit can be checked    }
+        { immediately. else check the range in between:       }
+        gensub(aint(t^._low - last));
+        if ((t^._low - last) <> 1) or
+          (not lastrange) then
+          tcgppc(cg).a_jmp_cond(exprasmlist, jmp_lt, elselabel);
+      end;
+      gensub(aint(t^._high - t^._low));
+      tcgppc(cg).a_jmp_cond(exprasmlist, jmp_le, blocklabel(t^.blockid));
+      last := t^._high;
+      lastrange := true;
+    end;
+    first := false;
+    if assigned(t^.greater) then
+      genitem(t^.greater);
+  end;
+
+begin
+  { do we need to generate cmps? }
+  if (with_sign and (min_label < 0)) or
+    (opsize = OS_32) then
+    genlinearcmplist(hp)
+  else
+  begin
+    last := 0;
+    lastrange := false;
+    first := true;
+    genitem(hp);
+    cg.a_jmp_always(exprasmlist, elselabel);
+  end;
+end;
+
+begin
+  ccasenode := tppccasenode;
+end.
+

+ 75 - 0
compiler/powerpc64/ppcins.dat

@@ -0,0 +1,75 @@
+;****************************************************************************
+;
+;   Copyright (c) 2002 by Florian Klaempfl
+;
+;   Instruction template table 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.
+;
+;****************************************************************************
+;
+add       rD,rA,rB              opcode=31,op22=266,oe=0,rc=0
+add_      rD,rA,rB              opcode=31,op22=266,oe=0,rc=1
+addo      rD,rA,rB              opcode=31,op22=266,oe=1,rc=0
+addo_     rD,rA,rB              opcode=31,op22=266,oe=1,rc=1
+addc      rD,rA,rB              opcode=31,op22=10,oe=0,rc=0
+addc_     rD,rA,rB              opcode=31,op22=10,oe=0,rc=1
+addco     rD,rA,rB              opcode=31,op22=10,oe=1,rc=0
+addco_    rD,rA,rB              opcode=31,op22=10,oe=1,rc=1
+adde      rD,rA,rB              opcode=31,op22=138,oe=0,rc=0
+adde_     rD,rA,rB              opcode=31,op22=138,oe=0,rc=1
+addeo     rD,rA,rB              opcode=31,op22=138,oe=1,rc=0
+addeo_    rD,rA,rB              opcode=31,op22=138,oe=1,rc=1
+addi      rD,rA,SIMM            opcode=14
+addic     rD,rA,SIMM            opcode=12
+addic_    rD,rA,SIMM            opcode=13
+addis     rD,rA,SIMM            opcode=15
+addme     rD,rA                 opcode=31,op22=234,oe=0,rc=0,reserved=$000f0000
+addme_    rD,rA                 opcode=31,op22=234,oe=0,rc=1,reserved=$000f0000
+addmeo    rD,rA                 opcode=31,op22=234,oe=1,rc=0,reserved=$000f0000
+addmeo_   rD,rA                 opcode=31,op22=234,oe=1,rc=1,reserved=$000f0000
+addze     rD,rA                 opcode=31,op22=202,oe=0,rc=0,reserved=$000f0000
+addze_    rD,rA                 opcode=31,op22=202,oe=0,rc=1,reserved=$000f0000
+addzeo    rD,rA                 opcode=31,op22=202,oe=1,rc=0,reserved=$000f0000
+addzeo_   rD,rA                 opcode=31,op22=202,oe=1,rc=1,reserved=$000f0000
+and       rA,rS,rB              opcode=31,op21=28,rc=0
+and_      rA,rS,rB              opcode=31,op21=28,rc=1
+andc      rA,rS,rB              opcode=31,op21=60,rc=0
+andc_     rA,rS,rB              opcode=31,op21=60,rc=1
+andi_     rA,rS,UIMM            opcode=28
+andis_    rA,rS,UIMM            opcode=29
+b         TA24                  opcode=18,aa=0,lk=0
+ba        TA24                  opcode=18,aa=1,lk=0
+bl        TA24                  opcode=18,aa=0,lk=1
+bla       TA24                  opcode=18,aa=1,lk=1
+bc        BO,BI,TA14            opcode=16,aa=0,lk=0
+bca       BO,BI,TA14            opcode=16,aa=1,lk=0
+bcl       BO,BI,TA14            opcode=16,aa=0,lk=1
+bcla      BO,BI,TA14            opcode=16,aa=1,lk=1
+bcctr     BO,BI                 opcode=19,op21=528,lk=0,reserved=$000f0000
+bcctrl    BO,BI                 opcode=19,op21=528,lk=1,reserved=$000f0000
+bcltr     BO,BI                 opcode=19,op21=16,lk=0,reserved=$000f0000
+bcltrl    BO,BI                 opcode=19,op21=16,lk=1,reserved=$000f0000
+cmp       crfD,L,rA,rB          opcode=31,op21=0,reserved=$80000200
+cmpi      crfD,L,rA,SIMM        opcode=11,reserved=$00000200
+cmpl      crfD,L,rA,rB          opcode=31,op21=32,reserved=$80000200
+cmpli     crfD,L,rA,UIMM        opcode=10,reserved=$00000200
+
+;
+
+; Revision 1.1  2002/07/13 21:50:34  florian
+;   + initial version, a lot of instructions need to be added
+;
+;

+ 143 - 0
compiler/powerpc64/ppcreg.dat

@@ -0,0 +1,143 @@
+;
+;
+; PowerPC registers
+;
+; layout
+; <name>,<value>,<stdname>,<gasname>,<gasshortname>,<motname>,<stabidx>
+;
+NO,$00,$00,INVALID,INVALID,INVALID,INVALID,-1,-1
+
+R0,$01,$00,r0,r0,0,r0,0,0
+R1,$01,$01,r1,r1,1,r1,1,1
+R2,$01,$02,r2,r2,2,r2,2,2
+R3,$01,$03,r3,r3,3,r3,3,3
+R4,$01,$04,r4,r4,4,r4,4,4
+R5,$01,$05,r5,r5,5,r5,5,5
+R6,$01,$06,r6,r6,6,r6,6,6
+R7,$01,$07,r7,r7,7,r7,7,7
+R8,$01,$08,r8,r8,8,r8,8,8
+R9,$01,$09,r9,r9,9,r9,9,9
+R10,$01,$0a,r10,r10,10,r10,10,10
+R11,$01,$0b,r11,r11,11,r11,11,11
+R12,$01,$0c,r12,r12,12,r12,12,12
+R13,$01,$0d,r13,r13,13,r13,13,13
+R14,$01,$0e,r14,r14,14,r14,14,14
+R15,$01,$0f,r15,r15,15,r15,15,15
+R16,$01,$10,r16,r16,16,r16,16,16
+R17,$01,$11,r17,r17,17,r17,17,17
+R18,$01,$12,r18,r18,18,r18,18,18
+R19,$01,$13,r19,r19,19,r19,19,19
+R20,$01,$14,r20,r20,20,r20,20,20
+R21,$01,$15,r21,r21,21,r21,21,21
+R22,$01,$16,r22,r22,22,r22,22,22
+R23,$01,$17,r23,r23,23,r23,23,23
+R24,$01,$18,r24,r24,24,r24,24,24
+R25,$01,$19,r25,r25,25,r25,25,25
+R26,$01,$1a,r26,r26,26,r26,26,26
+R27,$01,$1b,r27,r27,27,r27,27,27
+R28,$01,$1c,r28,r28,28,r28,28,28
+R29,$01,$1d,r29,r29,29,r29,29,29
+R30,$01,$1e,r30,r30,30,r30,30,30
+R31,$01,$1f,r31,r31,31,r31,31,31
+
+F0,$02,$00,F0,f0,0,F0,32,32
+F1,$02,$01,F1,f1,1,F1,33,33
+F2,$02,$02,F2,f2,2,F2,34,34
+F3,$02,$03,F3,f3,3,F3,35,35
+F4,$02,$04,F4,f4,4,F4,36,36
+F5,$02,$05,F5,f5,5,F5,37,37
+F6,$02,$06,F6,f6,6,F6,38,38
+F7,$02,$07,F7,f7,7,F7,39,39
+F8,$02,$08,F8,f8,8,F8,40,40
+F9,$02,$09,F9,f9,9,F9,41,41
+F10,$02,$0a,F10,f10,10,F10,42,42
+F11,$02,$0b,F11,f11,11,F11,43,43
+F12,$02,$0c,F12,f12,12,F12,44,44
+F13,$02,$0d,F13,f13,13,F13,45,45
+F14,$02,$0e,F14,f14,14,F14,46,46
+F15,$02,$0f,F15,f15,15,F15,47,47
+F16,$02,$10,F16,f16,16,F16,48,48
+F17,$02,$11,F17,f17,17,F17,49,49
+F18,$02,$12,F18,f18,18,F18,50,50
+F19,$02,$13,F19,f19,19,F19,51,51
+F20,$02,$14,F20,f20,20,F20,52,52
+F21,$02,$15,F21,f21,21,F21,53,53
+F22,$02,$16,F22,f22,22,F22,54,54
+F23,$02,$17,F23,f23,23,F23,55,55
+F24,$02,$18,F24,f24,24,F24,56,56
+F25,$02,$19,F25,f25,25,F25,57,57
+F26,$02,$1a,F26,f26,26,F26,58,58
+F27,$02,$1b,F27,f27,27,F27,59,59
+F28,$02,$1c,F28,f28,28,F28,60,60
+F29,$02,$1d,F29,f29,29,F29,61,61
+F30,$02,$1e,F30,f30,30,F30,62,62
+F31,$02,$1f,F31,f31,31,F31,63,63
+
+M0,$03,$00,M0,v0,0,M0,-1,-1
+M1,$03,$01,M1,v1,1,M1,-1,-1
+M2,$03,$02,M2,v2,2,M2,-1,-1
+M3,$03,$03,M3,v3,3,M3,-1,-1
+M4,$03,$04,M4,v4,4,M4,-1,-1
+M5,$03,$05,M5,v5,5,M5,-1,-1
+M6,$03,$06,M6,v6,6,M6,-1,-1
+M7,$03,$07,M7,v7,7,M7,-1,-1
+M8,$03,$08,M8,v8,8,M8,-1,-1
+M9,$03,$09,M9,v9,9,M9,-1,-1
+M10,$03,$0a,M10,v10,10,M10,-1,-1
+M11,$03,$0b,M11,v11,11,M11,-1,-1
+M12,$03,$0c,M12,v12,12,M12,-1,-1
+M13,$03,$0d,M13,v13,13,M13,-1,-1
+M14,$03,$0e,M14,v14,14,M14,-1,-1
+M15,$03,$0f,M15,v15,15,M15,-1,-1
+M16,$03,$10,M16,v16,16,M16,-1,-1
+M17,$03,$11,M17,v17,17,M17,-1,-1
+M18,$03,$12,M18,v18,18,M18,-1,-1
+M19,$03,$13,M19,v19,19,M19,-1,-1
+M20,$03,$14,M20,v20,20,M20,-1,-1
+M21,$03,$15,M21,v21,21,M21,-1,-1
+M22,$03,$16,M22,v22,22,M22,-1,-1
+M23,$03,$17,M23,v23,23,M23,-1,-1
+M24,$03,$18,M24,v24,24,M24,-1,-1
+M25,$03,$19,M25,v25,25,M25,-1,-1
+M26,$03,$1a,M26,v26,26,M26,-1,-1
+M27,$03,$1b,M27,v27,27,M27,-1,-1
+M28,$03,$1c,M28,v28,28,M28,-1,-1
+M29,$03,$1d,M29,v29,29,M29,-1,-1
+M30,$03,$1e,M30,v30,30,M30,-1,-1
+M31,$03,$1f,M31,v31,31,M31,-1,-1
+
+CR,$05,$00,CR,cr,cr,CR,-1,-1
+CR0,$05,$01,CR0,cr0,cr0,CR0,68,68
+CR1,$05,$02,CR1,cr1,cr1,CR1,69,69
+CR2,$05,$03,CR2,cr2,cr2,CR2,70,70
+CR3,$05,$04,CR3,cr3,cr3,CR3,71,71
+CR4,$05,$05,CR4,cr4,cr4,CR4,72,72
+CR5,$05,$06,CR5,cr5,cr5,CR5,73,73
+CR6,$05,$07,CR6,cr6,cr5,CR6,74,74
+CR7,$05,$08,CR7,cr7,cr6,CR7,75,75
+XER,$05,$09,XER,xer,xer,XER,76,76
+LR,$05,$0a,LR,lr,lr,LR,65,65
+CTR,$05,$0b,CTR,ctr,ctr,CTR,66,66
+FPSCR,$05,$0c,FPSCR,fpscr,fpscr,FPSCR,-1,-1
+
+;
+
+; Revision 1.6  2004/06/17 16:55:46  peter
+;   * powerpc compiles again
+;
+; Revision 1.5  2003/12/10 22:19:27  florian
+;   + short gas register names for smartlinking added
+;
+; Revision 1.4  2003/09/04 21:07:03  florian
+;   * ARM compiler compiles again
+;
+; Revision 1.3  2003/09/03 19:35:24  peter
+;   * powerpc compiles again
+;
+; Revision 1.2  2003/09/03 15:55:01  peter
+;   * NEWRA branch merged
+;
+; Revision 1.1.2.1  2003/09/02 20:48:22  peter
+;   * powerpc registers
+;
+;

+ 42 - 0
compiler/powerpc64/rappc.pas

@@ -0,0 +1,42 @@
+{
+    Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman
+
+    Handles the common ppc assembler reader routines
+
+    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 rappc;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  aasmbase, aasmtai, aasmcpu,
+  cpubase, rautils, cclasses;
+
+type
+  TPPCOperand = class(TOperand)
+  end;
+
+  TPPCInstruction = class(TInstruction)
+  end;
+
+implementation
+
+end.
+

+ 730 - 0
compiler/powerpc64/rappcgas.pas

@@ -0,0 +1,730 @@
+{
+    Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
+
+    Does the parsing for the PowerPC GNU AS styled inline assembler.
+
+    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 rappcgas;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  raatt, rappc;
+
+type
+  tppcattreader = class(tattreader)
+    function is_asmopcode(const s: string): boolean; override;
+    procedure handleopcode; override;
+    procedure BuildReference(oper: tppcoperand);
+    procedure BuildOperand(oper: tppcoperand);
+    procedure BuildOpCode(instr: tppcinstruction);
+    procedure ReadAt(oper: tppcoperand);
+    procedure ReadSym(oper: tppcoperand);
+    procedure ConvertCalljmp(instr: tppcinstruction);
+  end;
+
+implementation
+
+uses
+  { helpers }
+  cutils,
+  { global }
+  globtype, verbose,
+  systems,
+  { aasm }
+  cpubase, aasmbase, aasmtai, aasmcpu,
+  { symtable }
+  symconst, symsym,
+  { parser }
+  procinfo,
+  rabase, rautils,
+  cgbase, cgobj
+  ;
+
+procedure tppcattreader.ReadSym(oper: tppcoperand);
+var
+  tempstr: string;
+  typesize, l, k: aint;
+begin
+  tempstr := actasmpattern;
+  Consume(AS_ID);
+  { typecasting? }
+  if (actasmtoken = AS_LPAREN) and
+    SearchType(tempstr, typesize) then
+  begin
+    oper.hastype := true;
+    Consume(AS_LPAREN);
+    BuildOperand(oper);
+    Consume(AS_RPAREN);
+    if oper.opr.typ in [OPR_REFERENCE, OPR_LOCAL] then
+      oper.SetSize(typesize, true);
+  end
+  else if not oper.SetupVar(tempstr, false) then
+    Message1(sym_e_unknown_id, tempstr);
+  { record.field ? }
+  if actasmtoken = AS_DOT then
+  begin
+    BuildRecordOffsetSize(tempstr, l, k);
+    inc(oper.opr.ref.offset, l);
+  end;
+end;
+
+procedure tppcattreader.ReadAt(oper: tppcoperand);
+begin
+  { check for ...@ }
+  if actasmtoken = AS_AT then
+  begin
+    if (oper.opr.ref.symbol = nil) and
+      (oper.opr.ref.offset = 0) then
+      Message(asmr_e_invalid_reference_syntax);
+    Consume(AS_AT);
+    if actasmtoken = AS_ID then
+    begin
+      if upper(actasmpattern) = 'L' then
+        oper.opr.ref.refaddr := addr_low
+      else if upper(actasmpattern) = 'HA' then
+        oper.opr.ref.refaddr := addr_higha
+      else if upper(actasmpattern) = 'H' then
+        oper.opr.ref.refaddr := addr_high
+      else if upper(actasmpattern) = 'HIGHERA' then
+        oper.opr.ref.refaddr := addr_highera
+      else if upper(actasmpattern) = 'HIGHESTA' then
+        oper.opr.ref.refaddr := addr_highesta
+      else if upper(actasmpattern) = 'HIGHER' then
+        oper.opr.ref.refaddr := addr_higher
+      else if upper(actasmpattern) = 'HIGHEST' then
+        oper.opr.ref.refaddr := addr_highest
+      else
+        Message(asmr_e_invalid_reference_syntax);
+      Consume(AS_ID);
+    end
+    else
+      Message(asmr_e_invalid_reference_syntax);
+  end;
+end;
+
+procedure tppcattreader.BuildReference(oper: tppcoperand);
+
+  procedure Consume_RParen;
+  begin
+    if actasmtoken <> AS_RPAREN then
+    begin
+      Message(asmr_e_invalid_reference_syntax);
+      RecoverConsume(true);
+    end
+    else
+    begin
+      Consume(AS_RPAREN);
+      if not (actasmtoken in [AS_COMMA, AS_SEPARATOR, AS_END]) then
+      begin
+        Message(asmr_e_invalid_reference_syntax);
+        RecoverConsume(true);
+      end;
+    end;
+  end;
+
+var
+  l: aint;
+
+begin
+  Consume(AS_LPAREN);
+  case actasmtoken of
+    AS_INTNUM,
+      AS_MINUS,
+      AS_PLUS:
+      begin
+        { offset(offset) is invalid }
+        if oper.opr.Ref.Offset <> 0 then
+        begin
+          Message(asmr_e_invalid_reference_syntax);
+          RecoverConsume(true);
+        end
+        else
+        begin
+          oper.opr.Ref.Offset := BuildConstExpression(false, true);
+          Consume(AS_RPAREN);
+          if actasmtoken = AS_AT then
+            ReadAt(oper);
+        end;
+        exit;
+      end;
+    AS_REGISTER: { (reg ...  }
+      begin
+        if ((oper.opr.typ = OPR_REFERENCE) and (oper.opr.ref.base <> NR_NO)) or
+          ((oper.opr.typ = OPR_LOCAL) and (oper.opr.localsym.localloc.loc <>
+            LOC_REGISTER)) then
+          message(asmr_e_cannot_index_relative_var);
+        oper.opr.ref.base := actasmregister;
+        Consume(AS_REGISTER);
+        { can either be a register or a right parenthesis }
+        { (reg)        }
+        if actasmtoken = AS_RPAREN then
+        begin
+          Consume_RParen;
+          exit;
+        end;
+        { (reg,reg ..  }
+        Consume(AS_COMMA);
+        if (actasmtoken = AS_REGISTER) and
+          (oper.opr.Ref.Offset = 0) then
+        begin
+          oper.opr.ref.index := actasmregister;
+          Consume(AS_REGISTER);
+          Consume_RParen;
+        end
+        else
+        begin
+          Message(asmr_e_invalid_reference_syntax);
+          RecoverConsume(false);
+        end;
+      end; {end case }
+    AS_ID:
+      begin
+        ReadSym(oper);
+        { add a constant expression? }
+        if (actasmtoken = AS_PLUS) then
+        begin
+          l := BuildConstExpression(true, true);
+          case oper.opr.typ of
+            OPR_CONSTANT:
+              inc(oper.opr.val, l);
+            OPR_LOCAL:
+              inc(oper.opr.localsymofs, l);
+            OPR_REFERENCE:
+              inc(oper.opr.ref.offset, l);
+          else
+            internalerror(200309202);
+          end;
+        end;
+        Consume(AS_RPAREN);
+        if actasmtoken = AS_AT then
+          ReadAt(oper);
+      end;
+    AS_COMMA: { (, ...  can either be scaling, or index }
+      begin
+        Consume(AS_COMMA);
+        { Index }
+        if (actasmtoken = AS_REGISTER) then
+        begin
+          oper.opr.ref.index := actasmregister;
+          Consume(AS_REGISTER);
+          { check for scaling ... }
+          Consume_RParen;
+        end
+        else
+        begin
+          Message(asmr_e_invalid_reference_syntax);
+          RecoverConsume(false);
+        end;
+      end;
+  else
+    begin
+      Message(asmr_e_invalid_reference_syntax);
+      RecoverConsume(false);
+    end;
+  end;
+end;
+
+procedure tppcattreader.BuildOperand(oper: tppcoperand);
+var
+  expr: string;
+  typesize, l: aint;
+
+  procedure AddLabelOperand(hl: tasmlabel);
+  begin
+    if not (actasmtoken in [AS_PLUS, AS_MINUS, AS_LPAREN]) and
+      is_calljmp(actopcode) then
+    begin
+      oper.opr.typ := OPR_SYMBOL;
+      oper.opr.symbol := hl;
+    end
+    else
+    begin
+      oper.InitRef;
+      oper.opr.ref.symbol := hl;
+    end;
+  end;
+
+  procedure MaybeRecordOffset;
+  var
+    hasdot: boolean;
+    l,
+      toffset,
+      tsize: aint;
+  begin
+    if not (actasmtoken in [AS_DOT, AS_PLUS, AS_MINUS]) then
+      exit;
+    l := 0;
+    hasdot := (actasmtoken = AS_DOT);
+    if hasdot then
+    begin
+      if expr <> '' then
+      begin
+        BuildRecordOffsetSize(expr, toffset, tsize);
+        inc(l, toffset);
+        oper.SetSize(tsize, true);
+      end;
+    end;
+    if actasmtoken in [AS_PLUS, AS_MINUS] then
+      inc(l, BuildConstExpression(true, false));
+    case oper.opr.typ of
+      OPR_LOCAL:
+        begin
+          { don't allow direct access to fields of parameters, because that
+            will generate buggy code. Allow it only for explicit typecasting }
+          if hasdot and
+            (not oper.hastype) and
+            (tabstractvarsym(oper.opr.localsym).owner.symtabletype =
+              parasymtable) and
+            (current_procinfo.procdef.proccalloption <> pocall_register) then
+            Message(asmr_e_cannot_access_field_directly_for_parameters);
+          inc(oper.opr.localsymofs, l)
+        end;
+      OPR_CONSTANT:
+        inc(oper.opr.val, l);
+      OPR_REFERENCE:
+        inc(oper.opr.ref.offset, l);
+    else
+      internalerror(200309221);
+    end;
+  end;
+
+  function MaybeBuildReference: boolean;
+    { Try to create a reference, if not a reference is found then false
+      is returned }
+  begin
+    MaybeBuildReference := true;
+    case actasmtoken of
+      AS_INTNUM,
+        AS_MINUS,
+        AS_PLUS:
+        begin
+          oper.opr.ref.offset := BuildConstExpression(True, False);
+          if actasmtoken <> AS_LPAREN then
+            Message(asmr_e_invalid_reference_syntax)
+          else
+            BuildReference(oper);
+        end;
+      AS_LPAREN:
+        BuildReference(oper);
+      AS_ID: { only a variable is allowed ... }
+        begin
+          ReadSym(oper);
+          case actasmtoken of
+            AS_END,
+              AS_SEPARATOR,
+              AS_COMMA: ;
+            AS_LPAREN:
+              BuildReference(oper);
+          else
+            begin
+              Message(asmr_e_invalid_reference_syntax);
+              Consume(actasmtoken);
+            end;
+          end; {end case }
+        end;
+    else
+      MaybeBuildReference := false;
+    end; { end case }
+  end;
+
+var
+  tempreg: tregister;
+  hl: tasmlabel;
+  ofs: aint;
+begin
+  expr := '';
+  case actasmtoken of
+    AS_LPAREN: { Memory reference or constant expression }
+      begin
+        oper.InitRef;
+        BuildReference(oper);
+      end;
+
+    AS_INTNUM,
+      AS_MINUS,
+      AS_PLUS:
+      begin
+        { Constant memory offset }
+        { This must absolutely be followed by (  }
+        oper.InitRef;
+        oper.opr.ref.offset := BuildConstExpression(True, False);
+        if actasmtoken <> AS_LPAREN then
+        begin
+          ofs := oper.opr.ref.offset;
+          BuildConstantOperand(oper);
+          inc(oper.opr.val, ofs);
+        end
+        else
+          BuildReference(oper);
+      end;
+
+    AS_ID: { A constant expression, or a Variable ref.  }
+      begin
+        { Local Label ? }
+        if is_locallabel(actasmpattern) then
+        begin
+          CreateLocalLabel(actasmpattern, hl, false);
+          Consume(AS_ID);
+          AddLabelOperand(hl);
+        end
+        else
+          { Check for label } if SearchLabel(actasmpattern, hl, false) then
+          begin
+            Consume(AS_ID);
+            AddLabelOperand(hl);
+          end
+          else
+            { probably a variable or normal expression }
+            { or a procedure (such as in CALL ID)      }
+          begin
+            { is it a constant ? }
+            if SearchIConstant(actasmpattern, l) then
+            begin
+              if not (oper.opr.typ in [OPR_NONE, OPR_CONSTANT]) then
+                Message(asmr_e_invalid_operand_type);
+              BuildConstantOperand(oper);
+            end
+            else
+            begin
+              expr := actasmpattern;
+              Consume(AS_ID);
+              { typecasting? }
+              if (actasmtoken = AS_LPAREN) and
+                SearchType(expr, typesize) then
+              begin
+                oper.hastype := true;
+                Consume(AS_LPAREN);
+                BuildOperand(oper);
+                Consume(AS_RPAREN);
+                if oper.opr.typ in [OPR_REFERENCE, OPR_LOCAL] then
+                  oper.SetSize(typesize, true);
+              end
+              else
+              begin
+                if oper.SetupVar(expr, false) then
+                  ReadAt(oper)
+                else
+                begin
+                  { look for special symbols ... }
+                  if expr = '__HIGH' then
+                  begin
+                    consume(AS_LPAREN);
+                    if not oper.setupvar('high' + actasmpattern, false) then
+                      Message1(sym_e_unknown_id, 'high' + actasmpattern);
+                    consume(AS_ID);
+                    consume(AS_RPAREN);
+                  end
+                  else if expr = '__RESULT' then
+                    oper.SetUpResult
+                  else if expr = '__SELF' then
+                    oper.SetupSelf
+                  else if expr = '__OLDEBP' then
+                    oper.SetupOldEBP
+                  else
+                    Message1(sym_e_unknown_id, expr);
+                end;
+              end;
+            end;
+            if actasmtoken = AS_DOT then
+              MaybeRecordOffset;
+            { add a constant expression? }
+            if (actasmtoken = AS_PLUS) then
+            begin
+              l := BuildConstExpression(true, false);
+              case oper.opr.typ of
+                OPR_CONSTANT:
+                  inc(oper.opr.val, l);
+                OPR_LOCAL:
+                  inc(oper.opr.localsymofs, l);
+                OPR_REFERENCE:
+                  inc(oper.opr.ref.offset, l);
+              else
+                internalerror(200309202);
+              end;
+            end
+          end;
+        { Do we have a indexing reference, then parse it also }
+        if actasmtoken = AS_LPAREN then
+          BuildReference(oper);
+      end;
+
+    AS_REGISTER: { Register, a variable reference or a constant reference  }
+      begin
+        { save the type of register used. }
+        tempreg := actasmregister;
+        Consume(AS_REGISTER);
+        if (actasmtoken in [AS_END, AS_SEPARATOR, AS_COMMA]) then
+          if is_condreg(tempreg) and
+            ((actopcode = A_BC) or
+            (actopcode = A_BCCTR) or
+            (actopcode = A_BCLR) or
+            (actopcode = A_TW) or
+            (actopcode = A_TWI)) then
+          begin
+            { it isn't a real operand, everything is stored in the condition }
+            oper.opr.typ := OPR_NONE;
+            actcondition.cr := getsupreg(tempreg);
+          end
+          else
+          begin
+            if not (oper.opr.typ in [OPR_NONE, OPR_REGISTER]) then
+              Message(asmr_e_invalid_operand_type);
+            oper.opr.typ := OPR_REGISTER;
+            oper.opr.reg := tempreg;
+          end
+        else if is_condreg(tempreg) then
+        begin
+          if not (actcondition.cond in [C_T..C_DZF]) then
+            Message(asmr_e_syn_operand);
+          if actasmtoken = AS_STAR then
+          begin
+            consume(AS_STAR);
+            if (actasmtoken = AS_INTNUM) then
+            begin
+              consume(AS_INTNUM);
+              if actasmtoken = AS_PLUS then
+              begin
+                consume(AS_PLUS);
+                if (actasmtoken = AS_ID) then
+                begin
+                  oper.opr.typ := OPR_NONE;
+                  if actasmpattern = 'LT' then
+                    actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4
+                  else if actasmpattern = 'GT' then
+                    actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 + 1
+                  else if actasmpattern = 'EQ' then
+                    actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 + 2
+                  else if actasmpattern = 'SO' then
+                    actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 + 3
+                  else
+                    Message(asmr_e_syn_operand);
+                  consume(AS_ID);
+                end
+                else
+                  Message(asmr_e_syn_operand);
+              end
+              else
+                Message(asmr_e_syn_operand);
+            end
+            else
+              Message(asmr_e_syn_operand);
+          end
+          else
+            Message(asmr_e_syn_operand);
+        end
+        else
+          Message(asmr_e_syn_operand);
+      end;
+    AS_END,
+      AS_SEPARATOR,
+      AS_COMMA: ;
+  else
+    begin
+      Message(asmr_e_syn_operand);
+      Consume(actasmtoken);
+    end;
+  end; { end case }
+end;
+
+{*****************************************************************************
+                                tppcattreader
+*****************************************************************************}
+
+procedure tppcattreader.BuildOpCode(instr: tppcinstruction);
+var
+  operandnum: longint;
+begin
+  { opcode }
+  if (actasmtoken <> AS_OPCODE) then
+  begin
+    Message(asmr_e_invalid_or_missing_opcode);
+    RecoverConsume(true);
+    exit;
+  end;
+  { Fill the instr object with the current state }
+  with instr do
+  begin
+    Opcode := ActOpcode;
+    condition := ActCondition;
+  end;
+
+  { We are reading operands, so opcode will be an AS_ID }
+  operandnum := 1;
+  Consume(AS_OPCODE);
+  { Zero operand opcode ?  }
+  if actasmtoken in [AS_SEPARATOR, AS_END] then
+  begin
+    operandnum := 0;
+    exit;
+  end;
+  { Read the operands }
+  repeat
+    case actasmtoken of
+      AS_COMMA: { Operand delimiter }
+        begin
+          if operandnum > Max_Operands then
+            Message(asmr_e_too_many_operands)
+          else
+          begin
+            { condition operands doesn't set the operand but write to the
+              condition field of the instruction
+            }
+            if instr.Operands[operandnum].opr.typ <> OPR_NONE then
+              Inc(operandnum);
+          end;
+          Consume(AS_COMMA);
+        end;
+      AS_SEPARATOR,
+        AS_END: { End of asm operands for this opcode  }
+        begin
+          break;
+        end;
+    else
+      BuildOperand(instr.Operands[operandnum] as tppcoperand);
+    end; { end case }
+  until false;
+  if (operandnum = 1) and (instr.Operands[operandnum].opr.typ = OPR_NONE) then
+    dec(operandnum);
+  instr.Ops := operandnum;
+end;
+
+function tppcattreader.is_asmopcode(const s: string): boolean;
+var
+  str2opentry: tstr2opentry;
+  cond: tasmcondflag;
+  hs: string;
+
+begin
+  { making s a value parameter would break other assembler readers }
+  hs := s;
+  is_asmopcode := false;
+
+  { clear op code }
+  actopcode := A_None;
+  { clear condition }
+  fillchar(actcondition, sizeof(actcondition), 0);
+
+  { check for direction hint }
+  if hs[length(s)] = '-' then
+  begin
+    dec(ord(hs[0]));
+    actcondition.dirhint := DH_Minus;
+  end
+  else if hs[length(s)] = '+' then
+  begin
+    dec(ord(hs[0]));
+    actcondition.dirhint := DH_Plus;
+  end;
+  str2opentry := tstr2opentry(iasmops.search(hs));
+  if assigned(str2opentry) then
+  begin
+    if actcondition.dirhint <> DH_None then
+      message1(asmr_e_unknown_opcode, actasmpattern);
+    actopcode := str2opentry.op;
+    actasmtoken := AS_OPCODE;
+    is_asmopcode := true;
+    exit;
+  end;
+  { not found, check branch instructions }
+  if hs[1] = 'B' then
+  begin
+    { we can search here without an extra table which is sorted by string length
+      because we take the whole remaining string without the leading B }
+    if copy(hs, length(s) - 1, 2) = 'LR' then
+    begin
+      actopcode := A_BCLR;
+      setlength(hs, length(hs) - 2)
+    end
+    else if copy(hs, length(s) - 2, 3) = 'CTR' then
+    begin
+      actopcode := A_BCCTR;
+      setlength(hs, length(hs) - 3)
+    end
+    else
+      actopcode := A_BC;
+    for cond := low(TAsmCondFlag) to high(TAsmCondFlag) do
+      if copy(hs, 2, length(s) - 1) = UpperAsmCondFlag2Str[cond] then
+      begin
+        actcondition.simple := true;
+        actcondition.cond := cond;
+        if (cond in [C_LT, C_LE, C_EQ, C_GE, C_GT, C_NL, C_NE, C_NG, C_SO, C_NS,
+          C_UN, C_NU]) then
+          actcondition.cr := RS_CR0;
+        actasmtoken := AS_OPCODE;
+        is_asmopcode := true;
+        exit;
+      end;
+  end;
+end;
+
+procedure tppcattreader.ConvertCalljmp(instr: tppcinstruction);
+begin
+  if instr.Operands[1].opr.typ = OPR_REFERENCE then
+  begin
+    instr.Operands[1].opr.ref.refaddr := addr_full;
+    if (instr.Operands[1].opr.ref.base <> NR_NO) or
+      (instr.Operands[1].opr.ref.index <> NR_NO) then
+      Message(asmr_e_syn_operand);
+  end;
+end;
+
+procedure tppcattreader.handleopcode;
+var
+  instr: tppcinstruction;
+begin
+  instr := TPPCInstruction.Create(TPPCOperand);
+  BuildOpcode(instr);
+  instr.condition := actcondition;
+  if is_calljmp(instr.opcode) then
+    ConvertCalljmp(instr);
+  {
+  instr.AddReferenceSizes;
+  instr.SetInstructionOpsize;
+  instr.CheckOperandSizes;
+  }
+  instr.ConcatInstruction(curlist);
+  instr.Free;
+end;
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+const
+  asmmode_ppc_att_info: tasmmodeinfo =
+  (
+    id: asmmode_ppc_gas;
+    idtxt: 'GAS';
+    casmreader: tppcattreader;
+    );
+
+  asmmode_ppc_standard_info: tasmmodeinfo =
+  (
+    id: asmmode_standard;
+    idtxt: 'STANDARD';
+    casmreader: tppcattreader;
+    );
+
+initialization
+  RegisterAsmMode(asmmode_ppc_att_info);
+  RegisterAsmMode(asmmode_ppc_standard_info);
+end.
+

+ 46 - 0
compiler/powerpc64/rgcpu.pas

@@ -0,0 +1,46 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit implements the powerpc specific class for the register
+    allocator
+
+    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 rgcpu;
+
+{$I fpcdefs.inc}
+
+interface
+
+uses
+  aasmbase, aasmtai,
+  cpubase,
+  rgobj;
+
+type
+  trgcpu = class(trgobj)
+  end;
+
+implementation
+
+uses
+  cgobj, verbose, cutils;
+
+
+end.
+

+ 111 - 0
compiler/powerpc64/rppccon.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+NR_NO = tregister($00000000);
+NR_R0 = tregister($01000000);
+NR_R1 = tregister($01000001);
+NR_R2 = tregister($01000002);
+NR_R3 = tregister($01000003);
+NR_R4 = tregister($01000004);
+NR_R5 = tregister($01000005);
+NR_R6 = tregister($01000006);
+NR_R7 = tregister($01000007);
+NR_R8 = tregister($01000008);
+NR_R9 = tregister($01000009);
+NR_R10 = tregister($0100000a);
+NR_R11 = tregister($0100000b);
+NR_R12 = tregister($0100000c);
+NR_R13 = tregister($0100000d);
+NR_R14 = tregister($0100000e);
+NR_R15 = tregister($0100000f);
+NR_R16 = tregister($01000010);
+NR_R17 = tregister($01000011);
+NR_R18 = tregister($01000012);
+NR_R19 = tregister($01000013);
+NR_R20 = tregister($01000014);
+NR_R21 = tregister($01000015);
+NR_R22 = tregister($01000016);
+NR_R23 = tregister($01000017);
+NR_R24 = tregister($01000018);
+NR_R25 = tregister($01000019);
+NR_R26 = tregister($0100001a);
+NR_R27 = tregister($0100001b);
+NR_R28 = tregister($0100001c);
+NR_R29 = tregister($0100001d);
+NR_R30 = tregister($0100001e);
+NR_R31 = tregister($0100001f);
+NR_F0 = tregister($02000000);
+NR_F1 = tregister($02000001);
+NR_F2 = tregister($02000002);
+NR_F3 = tregister($02000003);
+NR_F4 = tregister($02000004);
+NR_F5 = tregister($02000005);
+NR_F6 = tregister($02000006);
+NR_F7 = tregister($02000007);
+NR_F8 = tregister($02000008);
+NR_F9 = tregister($02000009);
+NR_F10 = tregister($0200000a);
+NR_F11 = tregister($0200000b);
+NR_F12 = tregister($0200000c);
+NR_F13 = tregister($0200000d);
+NR_F14 = tregister($0200000e);
+NR_F15 = tregister($0200000f);
+NR_F16 = tregister($02000010);
+NR_F17 = tregister($02000011);
+NR_F18 = tregister($02000012);
+NR_F19 = tregister($02000013);
+NR_F20 = tregister($02000014);
+NR_F21 = tregister($02000015);
+NR_F22 = tregister($02000016);
+NR_F23 = tregister($02000017);
+NR_F24 = tregister($02000018);
+NR_F25 = tregister($02000019);
+NR_F26 = tregister($0200001a);
+NR_F27 = tregister($0200001b);
+NR_F28 = tregister($0200001c);
+NR_F29 = tregister($0200001d);
+NR_F30 = tregister($0200001e);
+NR_F31 = tregister($0200001f);
+NR_M0 = tregister($03000000);
+NR_M1 = tregister($03000001);
+NR_M2 = tregister($03000002);
+NR_M3 = tregister($03000003);
+NR_M4 = tregister($03000004);
+NR_M5 = tregister($03000005);
+NR_M6 = tregister($03000006);
+NR_M7 = tregister($03000007);
+NR_M8 = tregister($03000008);
+NR_M9 = tregister($03000009);
+NR_M10 = tregister($0300000a);
+NR_M11 = tregister($0300000b);
+NR_M12 = tregister($0300000c);
+NR_M13 = tregister($0300000d);
+NR_M14 = tregister($0300000e);
+NR_M15 = tregister($0300000f);
+NR_M16 = tregister($03000010);
+NR_M17 = tregister($03000011);
+NR_M18 = tregister($03000012);
+NR_M19 = tregister($03000013);
+NR_M20 = tregister($03000014);
+NR_M21 = tregister($03000015);
+NR_M22 = tregister($03000016);
+NR_M23 = tregister($03000017);
+NR_M24 = tregister($03000018);
+NR_M25 = tregister($03000019);
+NR_M26 = tregister($0300001a);
+NR_M27 = tregister($0300001b);
+NR_M28 = tregister($0300001c);
+NR_M29 = tregister($0300001d);
+NR_M30 = tregister($0300001e);
+NR_M31 = tregister($0300001f);
+NR_CR = tregister($05000000);
+NR_CR0 = tregister($05000001);
+NR_CR1 = tregister($05000002);
+NR_CR2 = tregister($05000003);
+NR_CR3 = tregister($05000004);
+NR_CR4 = tregister($05000005);
+NR_CR5 = tregister($05000006);
+NR_CR6 = tregister($05000007);
+NR_CR7 = tregister($05000008);
+NR_XER = tregister($05000009);
+NR_LR = tregister($0500000a);
+NR_CTR = tregister($0500000b);
+NR_FPSCR = tregister($0500000c);

+ 111 - 0
compiler/powerpc64/rppcdwrf.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+-1,
+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,
+32,
+33,
+34,
+35,
+36,
+37,
+38,
+39,
+40,
+41,
+42,
+43,
+44,
+45,
+46,
+47,
+48,
+49,
+50,
+51,
+52,
+53,
+54,
+55,
+56,
+57,
+58,
+59,
+60,
+61,
+62,
+63,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+68,
+69,
+70,
+71,
+72,
+73,
+74,
+75,
+76,
+65,
+66,
+-1

+ 111 - 0
compiler/powerpc64/rppcgas.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+'INVALID',
+'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',
+'v0',
+'v1',
+'v2',
+'v3',
+'v4',
+'v5',
+'v6',
+'v7',
+'v8',
+'v9',
+'v10',
+'v11',
+'v12',
+'v13',
+'v14',
+'v15',
+'v16',
+'v17',
+'v18',
+'v19',
+'v20',
+'v21',
+'v22',
+'v23',
+'v24',
+'v25',
+'v26',
+'v27',
+'v28',
+'v29',
+'v30',
+'v31',
+'cr',
+'cr0',
+'cr1',
+'cr2',
+'cr3',
+'cr4',
+'cr5',
+'cr6',
+'cr7',
+'xer',
+'lr',
+'ctr',
+'fpscr'

+ 111 - 0
compiler/powerpc64/rppcgri.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+0,
+97,
+98,
+99,
+100,
+101,
+102,
+103,
+104,
+105,
+108,
+33,
+34,
+43,
+44,
+45,
+46,
+47,
+48,
+49,
+50,
+51,
+52,
+35,
+53,
+54,
+55,
+56,
+57,
+58,
+59,
+60,
+61,
+62,
+36,
+63,
+64,
+37,
+38,
+39,
+40,
+41,
+42,
+109,
+107,
+1,
+2,
+11,
+12,
+13,
+14,
+15,
+16,
+17,
+18,
+19,
+20,
+3,
+21,
+22,
+23,
+24,
+25,
+26,
+27,
+28,
+29,
+30,
+4,
+31,
+32,
+5,
+6,
+7,
+8,
+9,
+10,
+65,
+66,
+75,
+76,
+77,
+78,
+79,
+80,
+81,
+82,
+83,
+84,
+67,
+85,
+86,
+87,
+88,
+89,
+90,
+91,
+92,
+93,
+94,
+68,
+95,
+96,
+69,
+70,
+71,
+72,
+73,
+74,
+106

+ 111 - 0
compiler/powerpc64/rppcgss.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+'INVALID',
+'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',
+'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',
+'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',
+'cr',
+'cr0',
+'cr1',
+'cr2',
+'cr3',
+'cr4',
+'cr5',
+'cr5',
+'cr6',
+'xer',
+'lr',
+'ctr',
+'fpscr'

+ 111 - 0
compiler/powerpc64/rppcmot.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+'INVALID',
+'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'

+ 111 - 0
compiler/powerpc64/rppcmri.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+97,
+98,
+99,
+100,
+101,
+102,
+103,
+104,
+105,
+108,
+33,
+34,
+43,
+44,
+45,
+46,
+47,
+48,
+49,
+50,
+51,
+52,
+35,
+53,
+54,
+55,
+56,
+57,
+58,
+59,
+60,
+61,
+62,
+36,
+63,
+64,
+37,
+38,
+39,
+40,
+41,
+42,
+109,
+0,
+107,
+65,
+66,
+75,
+76,
+77,
+78,
+79,
+80,
+81,
+82,
+83,
+84,
+67,
+85,
+86,
+87,
+88,
+89,
+90,
+91,
+92,
+93,
+94,
+68,
+95,
+96,
+69,
+70,
+71,
+72,
+73,
+74,
+106,
+1,
+2,
+11,
+12,
+13,
+14,
+15,
+16,
+17,
+18,
+19,
+20,
+3,
+21,
+22,
+23,
+24,
+25,
+26,
+27,
+28,
+29,
+30,
+4,
+31,
+32,
+5,
+6,
+7,
+8,
+9,
+10

+ 2 - 0
compiler/powerpc64/rppcnor.inc

@@ -0,0 +1,2 @@
+{ don't edit, this file is generated from ppcreg.dat }
+110

+ 111 - 0
compiler/powerpc64/rppcnum.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+tregister($00000000),
+tregister($01000000),
+tregister($01000001),
+tregister($01000002),
+tregister($01000003),
+tregister($01000004),
+tregister($01000005),
+tregister($01000006),
+tregister($01000007),
+tregister($01000008),
+tregister($01000009),
+tregister($0100000a),
+tregister($0100000b),
+tregister($0100000c),
+tregister($0100000d),
+tregister($0100000e),
+tregister($0100000f),
+tregister($01000010),
+tregister($01000011),
+tregister($01000012),
+tregister($01000013),
+tregister($01000014),
+tregister($01000015),
+tregister($01000016),
+tregister($01000017),
+tregister($01000018),
+tregister($01000019),
+tregister($0100001a),
+tregister($0100001b),
+tregister($0100001c),
+tregister($0100001d),
+tregister($0100001e),
+tregister($0100001f),
+tregister($02000000),
+tregister($02000001),
+tregister($02000002),
+tregister($02000003),
+tregister($02000004),
+tregister($02000005),
+tregister($02000006),
+tregister($02000007),
+tregister($02000008),
+tregister($02000009),
+tregister($0200000a),
+tregister($0200000b),
+tregister($0200000c),
+tregister($0200000d),
+tregister($0200000e),
+tregister($0200000f),
+tregister($02000010),
+tregister($02000011),
+tregister($02000012),
+tregister($02000013),
+tregister($02000014),
+tregister($02000015),
+tregister($02000016),
+tregister($02000017),
+tregister($02000018),
+tregister($02000019),
+tregister($0200001a),
+tregister($0200001b),
+tregister($0200001c),
+tregister($0200001d),
+tregister($0200001e),
+tregister($0200001f),
+tregister($03000000),
+tregister($03000001),
+tregister($03000002),
+tregister($03000003),
+tregister($03000004),
+tregister($03000005),
+tregister($03000006),
+tregister($03000007),
+tregister($03000008),
+tregister($03000009),
+tregister($0300000a),
+tregister($0300000b),
+tregister($0300000c),
+tregister($0300000d),
+tregister($0300000e),
+tregister($0300000f),
+tregister($03000010),
+tregister($03000011),
+tregister($03000012),
+tregister($03000013),
+tregister($03000014),
+tregister($03000015),
+tregister($03000016),
+tregister($03000017),
+tregister($03000018),
+tregister($03000019),
+tregister($0300001a),
+tregister($0300001b),
+tregister($0300001c),
+tregister($0300001d),
+tregister($0300001e),
+tregister($0300001f),
+tregister($05000000),
+tregister($05000001),
+tregister($05000002),
+tregister($05000003),
+tregister($05000004),
+tregister($05000005),
+tregister($05000006),
+tregister($05000007),
+tregister($05000008),
+tregister($05000009),
+tregister($0500000a),
+tregister($0500000b),
+tregister($0500000c)

+ 111 - 0
compiler/powerpc64/rppcrni.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+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,
+32,
+33,
+34,
+35,
+36,
+37,
+38,
+39,
+40,
+41,
+42,
+43,
+44,
+45,
+46,
+47,
+48,
+49,
+50,
+51,
+52,
+53,
+54,
+55,
+56,
+57,
+58,
+59,
+60,
+61,
+62,
+63,
+64,
+65,
+66,
+67,
+68,
+69,
+70,
+71,
+72,
+73,
+74,
+75,
+76,
+77,
+78,
+79,
+80,
+81,
+82,
+83,
+84,
+85,
+86,
+87,
+88,
+89,
+90,
+91,
+92,
+93,
+94,
+95,
+96,
+97,
+98,
+99,
+100,
+101,
+102,
+103,
+104,
+105,
+106,
+107,
+108,
+109

+ 111 - 0
compiler/powerpc64/rppcsri.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+97,
+98,
+99,
+100,
+101,
+102,
+103,
+104,
+105,
+108,
+33,
+34,
+43,
+44,
+45,
+46,
+47,
+48,
+49,
+50,
+51,
+52,
+35,
+53,
+54,
+55,
+56,
+57,
+58,
+59,
+60,
+61,
+62,
+36,
+63,
+64,
+37,
+38,
+39,
+40,
+41,
+42,
+109,
+0,
+107,
+65,
+66,
+75,
+76,
+77,
+78,
+79,
+80,
+81,
+82,
+83,
+84,
+67,
+85,
+86,
+87,
+88,
+89,
+90,
+91,
+92,
+93,
+94,
+68,
+95,
+96,
+69,
+70,
+71,
+72,
+73,
+74,
+106,
+1,
+2,
+11,
+12,
+13,
+14,
+15,
+16,
+17,
+18,
+19,
+20,
+3,
+21,
+22,
+23,
+24,
+25,
+26,
+27,
+28,
+29,
+30,
+4,
+31,
+32,
+5,
+6,
+7,
+8,
+9,
+10

+ 111 - 0
compiler/powerpc64/rppcstab.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+-1,
+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,
+32,
+33,
+34,
+35,
+36,
+37,
+38,
+39,
+40,
+41,
+42,
+43,
+44,
+45,
+46,
+47,
+48,
+49,
+50,
+51,
+52,
+53,
+54,
+55,
+56,
+57,
+58,
+59,
+60,
+61,
+62,
+63,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+68,
+69,
+70,
+71,
+72,
+73,
+74,
+75,
+76,
+65,
+66,
+-1

+ 111 - 0
compiler/powerpc64/rppcstd.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+'INVALID',
+'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'

+ 111 - 0
compiler/powerpc64/rppcsup.inc

@@ -0,0 +1,111 @@
+{ don't edit, this file is generated from ppcreg.dat }
+RS_NO = $00;
+RS_R0 = $00;
+RS_R1 = $01;
+RS_R2 = $02;
+RS_R3 = $03;
+RS_R4 = $04;
+RS_R5 = $05;
+RS_R6 = $06;
+RS_R7 = $07;
+RS_R8 = $08;
+RS_R9 = $09;
+RS_R10 = $0a;
+RS_R11 = $0b;
+RS_R12 = $0c;
+RS_R13 = $0d;
+RS_R14 = $0e;
+RS_R15 = $0f;
+RS_R16 = $10;
+RS_R17 = $11;
+RS_R18 = $12;
+RS_R19 = $13;
+RS_R20 = $14;
+RS_R21 = $15;
+RS_R22 = $16;
+RS_R23 = $17;
+RS_R24 = $18;
+RS_R25 = $19;
+RS_R26 = $1a;
+RS_R27 = $1b;
+RS_R28 = $1c;
+RS_R29 = $1d;
+RS_R30 = $1e;
+RS_R31 = $1f;
+RS_F0 = $00;
+RS_F1 = $01;
+RS_F2 = $02;
+RS_F3 = $03;
+RS_F4 = $04;
+RS_F5 = $05;
+RS_F6 = $06;
+RS_F7 = $07;
+RS_F8 = $08;
+RS_F9 = $09;
+RS_F10 = $0a;
+RS_F11 = $0b;
+RS_F12 = $0c;
+RS_F13 = $0d;
+RS_F14 = $0e;
+RS_F15 = $0f;
+RS_F16 = $10;
+RS_F17 = $11;
+RS_F18 = $12;
+RS_F19 = $13;
+RS_F20 = $14;
+RS_F21 = $15;
+RS_F22 = $16;
+RS_F23 = $17;
+RS_F24 = $18;
+RS_F25 = $19;
+RS_F26 = $1a;
+RS_F27 = $1b;
+RS_F28 = $1c;
+RS_F29 = $1d;
+RS_F30 = $1e;
+RS_F31 = $1f;
+RS_M0 = $00;
+RS_M1 = $01;
+RS_M2 = $02;
+RS_M3 = $03;
+RS_M4 = $04;
+RS_M5 = $05;
+RS_M6 = $06;
+RS_M7 = $07;
+RS_M8 = $08;
+RS_M9 = $09;
+RS_M10 = $0a;
+RS_M11 = $0b;
+RS_M12 = $0c;
+RS_M13 = $0d;
+RS_M14 = $0e;
+RS_M15 = $0f;
+RS_M16 = $10;
+RS_M17 = $11;
+RS_M18 = $12;
+RS_M19 = $13;
+RS_M20 = $14;
+RS_M21 = $15;
+RS_M22 = $16;
+RS_M23 = $17;
+RS_M24 = $18;
+RS_M25 = $19;
+RS_M26 = $1a;
+RS_M27 = $1b;
+RS_M28 = $1c;
+RS_M29 = $1d;
+RS_M30 = $1e;
+RS_M31 = $1f;
+RS_CR = $00;
+RS_CR0 = $01;
+RS_CR1 = $02;
+RS_CR2 = $03;
+RS_CR3 = $04;
+RS_CR4 = $05;
+RS_CR5 = $06;
+RS_CR6 = $07;
+RS_CR7 = $08;
+RS_XER = $09;
+RS_LR = $0a;
+RS_CTR = $0b;
+RS_FPSCR = $0c;

+ 7 - 0
compiler/pp.pas

@@ -31,6 +31,7 @@ program pp;
   M68K                generate a compiler for the M68000
   M68K                generate a compiler for the M68000
   SPARC               generate a compiler for SPARC
   SPARC               generate a compiler for SPARC
   POWERPC             generate a compiler for the PowerPC
   POWERPC             generate a compiler for the PowerPC
+  POWERPC64           generate a compiler for the PowerPC64 architecture
   VIS                 generate a compile for the VIS
   VIS                 generate a compile for the VIS
   DEBUG               version with debug code is generated
   DEBUG               version with debug code is generated
   EXTDEBUG            some extra debug code is executed
   EXTDEBUG            some extra debug code is executed
@@ -100,6 +101,12 @@ program pp;
      {$endif CPUDEFINED}
      {$endif CPUDEFINED}
      {$define CPUDEFINED}
      {$define CPUDEFINED}
    {$endif POWERPC}
    {$endif POWERPC}
+   {$ifdef POWERPC64}
+     {$ifdef CPUDEFINED}
+        {$fatal ONLY one of the switches for the CPU type must be defined}
+     {$endif CPUDEFINED}
+     {$define CPUDEFINED}
+   {$endif POWERPC64}
    {$ifdef ALPHA}
    {$ifdef ALPHA}
      {$ifdef CPUDEFINED}
      {$ifdef CPUDEFINED}
         {$fatal ONLY one of the switches for the CPU type must be defined}
         {$fatal ONLY one of the switches for the CPU type must be defined}

+ 6 - 0
compiler/psystem.pas

@@ -374,6 +374,12 @@ implementation
         s80floattype.setdef(tfloatdef.create(s80real));
         s80floattype.setdef(tfloatdef.create(s80real));
         s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
         s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
 {$endif powerpc}
 {$endif powerpc}
+{$ifdef POWERPC64}
+        s32floattype.setdef(tfloatdef.create(s32real));
+        s64floattype.setdef(tfloatdef.create(s64real));
+        s80floattype.setdef(tfloatdef.create(s80real));
+        s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
+{$endif POWERPC64}
 {$ifdef sparc}
 {$ifdef sparc}
         s32floattype.setdef(tfloatdef.create(s32real));
         s32floattype.setdef(tfloatdef.create(s32real));
         s64floattype.setdef(tfloatdef.create(s64real));
         s64floattype.setdef(tfloatdef.create(s64real));

+ 13 - 0
compiler/raatt.pas

@@ -276,6 +276,19 @@ unit raatt;
                end
                end
            end;
            end;
 {$endif POWERPC}
 {$endif POWERPC}
+{$ifdef POWERPC64}
+           { some PowerPC instructions can have the postfix -, + or .
+             this code could be moved to is_asmopcode but I think
+             it's better to ifdef it here (FK)
+           }
+           case c of
+             '.', '-', '+':
+               begin
+                 actasmpattern:=actasmpattern+c;
+                 c:=current_scanner.asmgetchar;
+               end
+           end;
+{$endif POWERPC64}
            { Opcode ? }
            { Opcode ? }
            If is_asmopcode(upper(actasmpattern)) then
            If is_asmopcode(upper(actasmpattern)) then
             Begin
             Begin

+ 3 - 0
compiler/rautils.pas

@@ -81,6 +81,9 @@ type
 {$ifdef powerpc}
 {$ifdef powerpc}
       OPR_COND      : (cond : tasmcond);
       OPR_COND      : (cond : tasmcond);
 {$endif powerpc}
 {$endif powerpc}
+{$ifdef POWERPC64}
+      OPR_COND      : (cond : tasmcond);
+{$endif POWERPC64}
 {$ifdef arm}
 {$ifdef arm}
       OPR_REGSET    : (regset : tcpuregisterset);
       OPR_REGSET    : (regset : tcpuregisterset);
       OPR_SHIFTEROP : (shifterop : tshifterop);
       OPR_SHIFTEROP : (shifterop : tshifterop);

+ 3 - 0
compiler/symdef.pas

@@ -817,6 +817,9 @@ interface
 {$ifdef powerpc}
 {$ifdef powerpc}
        pbestrealtype : ^ttype = @s64floattype;
        pbestrealtype : ^ttype = @s64floattype;
 {$endif}
 {$endif}
+{$ifdef POWERPC64}
+       pbestrealtype : ^ttype = @s64floattype;
+{$endif}
 {$ifdef ia64}
 {$ifdef ia64}
        pbestrealtype : ^ttype = @s64floattype;
        pbestrealtype : ^ttype = @s64floattype;
 {$endif}
 {$endif}

+ 12 - 3
compiler/systems.pas

@@ -50,7 +50,8 @@ interface
              cpu_iA64,                     { 7 }
              cpu_iA64,                     { 7 }
              cpu_x86_64,                   { 8 }
              cpu_x86_64,                   { 8 }
              cpu_mips,                     { 9 }
              cpu_mips,                     { 9 }
-             cpu_arm                       { 10 }
+             cpu_arm,                      { 10 }
+             cpu_powerpc64                 { 11 }
        );
        );
 
 
        tasmmode= (asmmode_none
        tasmmode= (asmmode_none
@@ -118,7 +119,8 @@ interface
              system_ia64_win64,         { 39 }
              system_ia64_win64,         { 39 }
              system_i386_wince,         { 40 }
              system_i386_wince,         { 40 }
              system_x86_6432_linux,     { 41 }
              system_x86_6432_linux,     { 41 }
-             system_arm_gba             { 42 }
+             system_arm_gba,            { 42 }
+             system_powerpc64_linux     { 43 }
        );
        );
 
 
        tasm = (as_none
        tasm = (as_none
@@ -324,7 +326,7 @@ interface
 
 
        cpu2str : array[TSystemCpu] of string =
        cpu2str : array[TSystemCpu] of string =
             ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64',
             ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64',
-             'mips','arm');
+             'mips','arm', 'powerpc64');
 
 
     var
     var
        targetinfos   : array[tsystem] of psysteminfo;
        targetinfos   : array[tsystem] of psysteminfo;
@@ -754,6 +756,13 @@ begin
     default_target(system_powerpc_linux);
     default_target(system_powerpc_linux);
   {$endif cpupowerpc}
   {$endif cpupowerpc}
 {$endif powerpc}
 {$endif powerpc}
+{$ifdef POWERPC64}
+  {$ifdef cpupowerpc64}
+    default_target(source_info.system);
+  {$else cpupowerpc64}
+    default_target(system_powerpc64_linux);
+  {$endif cpupowerpc64}
+{$endif POWERPC64}
 {$ifdef sparc}
 {$ifdef sparc}
   {$ifdef cpusparc}
   {$ifdef cpusparc}
     default_target(source_info.system);
     default_target(source_info.system);

+ 70 - 2
compiler/systems/i_linux.pas

@@ -293,6 +293,69 @@ unit i_linux;
             abi : abi_powerpc_sysv;
             abi : abi_powerpc_sysv;
           );
           );
 
 
+       system_powerpc64_linux_info : tsysteminfo =
+          (
+            system       : system_powerpc64_LINUX;
+            name         : 'Linux for PowerPC64';
+            shortname    : 'Linux';
+            flags        : [tf_needs_symbol_size];
+            cpu          : cpu_powerpc64;
+            unit_env     : '';
+            extradefines : 'UNIX;HASUNIX';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            staticlibprefix : 'libp';
+            sharedlibprefix : 'lib';
+            sharedClibext : '.so';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : 'lib';
+            p_ext_support : false;
+            Cprefix      : '';
+            newline      : #10;
+            dirsep       : '/';
+            files_case_relevent : true;
+            assem        : as_gas;
+            assemextern  : as_gas;
+            link         : nil;
+            linkextern   : nil;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            dbg          : dbg_stabs;
+            script       : script_unix;
+            endian       : endian_big;
+            alignment    :
+              (
+                procalign       : 8;
+                loopalign       : 4;
+                jumpalign       : 0;
+                constalignmin   : 0;
+                constalignmax   : 8;
+                varalignmin     : 0;
+                varalignmax     : 8;
+                localalignmin   : 4;
+                localalignmax   : 8;
+                recordalignmin  : 0;
+                recordalignmax  : 8;
+                maxCrecordalign : 8
+              );
+            first_parm_offset : 8;
+            stacksize    : 32*1024*1024;
+            DllScanSupported:false;
+            use_function_relative_addresses : true;
+            abi : abi_default
+          );         
+
        system_alpha_linux_info : tsysteminfo =
        system_alpha_linux_info : tsysteminfo =
           (
           (
             system       : system_alpha_LINUX;
             system       : system_alpha_LINUX;
@@ -577,11 +640,16 @@ initialization
     set_source_info(system_sparc_linux_info);
     set_source_info(system_sparc_linux_info);
   {$endif linux}
   {$endif linux}
 {$endif CPUSPARC}
 {$endif CPUSPARC}
-{$ifdef CPUPOWERPC}
+{$ifdef CPUPOWERPC32}
   {$ifdef linux}
   {$ifdef linux}
     set_source_info(system_powerpc_linux_info);
     set_source_info(system_powerpc_linux_info);
   {$endif linux}
   {$endif linux}
-{$endif CPUPOWERPC}
+{$endif CPUPOWERPC32}
+{$ifdef CPUPOWERPC64}
+  {$ifdef linux}
+    set_source_info(system_powerpc64_linux_info);
+  {$endif linux}
+{$endif CPUPOWERPC64}
 {$ifdef CPUARM}
 {$ifdef CPUARM}
   {$ifdef linux}
   {$ifdef linux}
     set_source_info(system_arm_linux_info);
     set_source_info(system_arm_linux_info);

+ 12 - 0
compiler/systems/t_linux.pas

@@ -207,6 +207,7 @@ const
 {$ifdef i386}   platform_select='-b elf32-i386 -m elf_i386';{$endif}
 {$ifdef i386}   platform_select='-b elf32-i386 -m elf_i386';{$endif}
 {$ifdef x86_64} platform_select='-b elf64-x86-64 -m elf_x86_64';{$endif}
 {$ifdef x86_64} platform_select='-b elf64-x86-64 -m elf_x86_64';{$endif}
 {$ifdef powerpc}platform_select='-b elf32-powerpc -m elf32ppclinux';{$endif}
 {$ifdef powerpc}platform_select='-b elf32-powerpc -m elf32ppclinux';{$endif}
+{$ifdef POWERPC64}  platform_select='-b elf64-powerpc -m elf64ppc';{$endif}
 {$ifdef sparc}  platform_select='-b elf32-sparc -m elf32_sparc';{$endif}
 {$ifdef sparc}  platform_select='-b elf32-sparc -m elf32_sparc';{$endif}
 {$ifdef arm}    platform_select='';{$endif} {unknown :( }
 {$ifdef arm}    platform_select='';{$endif} {unknown :( }
 {$ifdef m68k}    platform_select='';{$endif} {unknown :( }
 {$ifdef m68k}    platform_select='';{$endif} {unknown :( }
@@ -272,6 +273,11 @@ begin
      libctype:=glibc2;
      libctype:=glibc2;
 {$endif powerpc}
 {$endif powerpc}
 
 
+{$ifdef powerpc64}
+     DynamicLinker:='/lib64/ld.so.1';
+     libctype:=glibc2;
+{$endif powerpc64}
+
 {$ifdef arm}
 {$ifdef arm}
      DynamicLinker:='/lib/ld-linux.so.2';
      DynamicLinker:='/lib/ld-linux.so.2';
      libctype:=glibc2;
      libctype:=glibc2;
@@ -709,6 +715,12 @@ initialization
   RegisterExport(system_powerpc_linux,texportliblinux);
   RegisterExport(system_powerpc_linux,texportliblinux);
   RegisterTarget(system_powerpc_linux_info);
   RegisterTarget(system_powerpc_linux_info);
 {$endif powerpc}
 {$endif powerpc}
+{$ifdef powerpc64}
+  RegisterExternalLinker(system_powerpc64_linux_info,TLinkerLinux);
+  RegisterImport(system_powerpc64_linux,timportliblinux);
+  RegisterExport(system_powerpc64_linux,texportliblinux);
+  RegisterTarget(system_powerpc64_linux_info);
+{$endif powerpc64}
 {$ifdef alpha}
 {$ifdef alpha}
   RegisterExternalLinker(system_alpha_linux_info,TLinkerLinux);
   RegisterExternalLinker(system_alpha_linux_info,TLinkerLinux);
   RegisterImport(system_alpha_linux,timportliblinux);
   RegisterImport(system_alpha_linux,timportliblinux);

+ 4 - 0
compiler/tgobj.pas

@@ -161,7 +161,11 @@ implementation
 {$ifdef powerpc}
 {$ifdef powerpc}
        direction:=1;
        direction:=1;
 {$else powerpc}
 {$else powerpc}
+{$ifdef POWERPC64}
+       direction:=1;
+{$else POWERPC64}
        direction:=-1;
        direction:=-1;
+{$endif POWERPC64}
 {$endif powerpc}
 {$endif powerpc}
      end;
      end;
 
 

+ 5 - 2
compiler/version.pas

@@ -44,9 +44,12 @@ interface
 {$ifdef cpu86}
 {$ifdef cpu86}
         source_cpu_string = 'i386';
         source_cpu_string = 'i386';
 {$endif cpu86}
 {$endif cpu86}
-{$ifdef cpupowerpc}
+{$ifdef cpupowerpc32}
         source_cpu_string = 'powerpc';
         source_cpu_string = 'powerpc';
-{$endif cpupowerpc}
+{$endif cpupowerpc32}
+{$ifdef cpupowerpc64}
+        source_cpu_string = 'powerpc64';
+{$endif cpupowerpc64}
 {$ifdef cpum68k}
 {$ifdef cpum68k}
         source_cpu_string = 'm68k';
         source_cpu_string = 'm68k';
 {$endif cpum68k}
 {$endif cpum68k}

+ 30 - 0
rtl/linux/powerpc64/bsyscall.inc

@@ -0,0 +1,30 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2005 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    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.
+
+ **********************************************************************}
+
+
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2005 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    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.
+
+ **********************************************************************}
+
+

+ 282 - 0
rtl/linux/powerpc64/cprt0.as

@@ -0,0 +1,282 @@
+/*
+*/
+/* Startup code for programs linked with GNU libc.
+   Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library 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
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+   
+.macro LOAD_64BIT_VAL ra, value 
+	addis           \ra, 0, \value@highest
+	ori             \ra,\ra,\value@higher
+	sldi            \ra,\ra,32
+	oris            \ra,\ra,\value@h
+	ori             \ra,\ra,\value@l	
+.endm
+
+.macro FUNCTION_PROLOG fn
+	.section	".text"
+	.align	2
+	.globl	\fn
+	.section	".opd", "aw"
+	.align	3
+	\fn:
+	.quad	.\fn, .TOC.@tocbase, 0
+	.previous
+	.size	\fn, 24
+	.type	\fn, @function	
+	.globl	.\fn
+.\fn:
+.endm
+
+.macro FUNCTION_EPILOG fn
+	.long	0
+	.byte	0, 12, 0, 0, 0, 0, 0, 0
+	.type	.\fn, @function
+	.size	.\fn,.-.\fn
+.endm
+
+.macro PRINTMSG msg len
+	lis	4, \msg@highest
+	ori	4, 4, \msg@higher
+	sldi	4, 4, 32
+	oris	4, 4, \msg@h
+	ori	4, 4, \msg@l	
+	li	5, \len	
+	li	0,4
+	li	3,1
+	sc
+.endm
+	/* 
+	cprt0 pascal entry
+	*/
+FUNCTION_PROLOG _start
+
+	mr 	26, 1
+	/* Set up an initial stack frame, and clear the LR */
+	clrrdi  1, 1, 5       /* align r1 */
+	li      0, 0          
+	stdu    1,-48(1)      
+	mtlr    0             
+	std     0, 0(1)       /* r1 = pointer to NULL value */
+
+	/* store argument count (= 0(r1) )*/
+	ld      3, 0(26)
+	LOAD_64BIT_VAL 10, operatingsystem_parameter_argc
+	stw     3, 0(10)
+	/* calculate argument vector address and store (= 8(r1) + 8 ) */
+	addi    4, 26, 8
+	LOAD_64BIT_VAL 10, operatingsystem_parameter_argv
+	std     4, 0(10)
+	/* store environment pointer (= argv + (argc+1)* 8 ) */
+	addi    5, 3, 1
+	sldi    5, 5, 3
+	add     5, 4, 5
+	LOAD_64BIT_VAL 10, operatingsystem_parameter_envp
+	std     5, 0(10)
+	
+	bl	.__libc_init_first
+	nop
+	
+	lis	3, _dl_fini@highest
+	ori	3, 3, _dl_fini@higher
+	sldi	3,3,32
+	oris	3, 3, _dl_fini@h
+	ori	3, 3, _dl_fini@l
+
+	bl      .PASCALMAIN
+	nop
+	ori     0, 0, 0
+
+	/* directly jump to exit procedure, not via the function pointer */
+	b       _haltproc
+	
+	.align  3
+
+	.global ._haltproc
+	.section        ".opd", "aw"
+	.align 3
+._haltproc:
+	.quad   _haltproc, .TOC.@tocbase, 0
+	.previous
+	.size ._haltproc, 24
+	.global _haltproc
+
+_haltproc:
+	/* exit call */
+	li      0, 1
+	sc
+	b       _haltproc
+
+	/* Define a symbol for the first piece of initialized data.  */
+	.section ".data"
+	.globl  __data_start
+__data_start:
+data_start:
+	.globl  ___fpc_brk_addr	/* heap management */
+	.type   ___fpc_brk_addr, @object
+	.size   ___fpc_brk_addr, 4
+___fpc_brk_addr:
+	.long   0
+
+.text
+	.comm operatingsystem_parameter_argc, 4
+	.comm operatingsystem_parameter_argv, 8
+	.comm operatingsystem_parameter_envp, 8
+	.comm operatingsystem_parameter_auxp, 8
+	.comm operatingsystem_parameter_exitp, 8
+
+/*
+*/
+/* Startup code for programs linked with GNU libc.
+   Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library 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
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+
+.macro LOAD_64BIT_VAL ra, value
+        addis           \ra, 0, \value@highest
+        ori             \ra,\ra,\value@higher
+        sldi            \ra,\ra,32
+        oris            \ra,\ra,\value@h
+        ori             \ra,\ra,\value@l
+.endm
+
+.macro FUNCTION_PROLOG fn
+        .section        ".text"
+        .align  2
+        .globl  \fn
+        .section        ".opd", "aw"
+        .align  3
+        \fn:
+        .quad   .\fn, .TOC.@tocbase, 0
+        .previous
+        .size   \fn, 24
+        .type   \fn, @function
+        .globl  .\fn
+.\fn:
+.endm
+
+.macro FUNCTION_EPILOG fn
+        .long   0
+        .byte   0, 12, 0, 0, 0, 0, 0, 0
+        .type   .\fn, @function
+        .size   .\fn,.-.\fn
+.endm
+
+.macro PRINTMSG msg len
+        lis     4, \msg@highest
+        ori     4, 4, \msg@higher
+        sldi    4, 4, 32
+        oris    4, 4, \msg@h
+        ori     4, 4, \msg@l
+        li      5, \len
+        li      0,4
+        li      3,1
+        sc
+.endm
+        /*
+        cprt0 pascal entry
+        */
+FUNCTION_PROLOG _start
+
+        mr      26, 1
+        /* Set up an initial stack frame, and clear the LR */
+        clrrdi  1, 1, 5       /* align r1 */
+        li      0, 0
+        stdu    1,-48(1)
+        mtlr    0
+        std     0, 0(1)       /* r1 = pointer to NULL value */
+
+        /* store argument count (= 0(r1) )*/
+        ld      3, 0(26)
+        LOAD_64BIT_VAL 10, operatingsystem_parameter_argc
+        stw     3, 0(10)
+        /* calculate argument vector address and store (= 8(r1) + 8 ) */
+        addi    4, 26, 8
+        LOAD_64BIT_VAL 10, operatingsystem_parameter_argv
+        std     4, 0(10)
+        /* store environment pointer (= argv + (argc+1)* 8 ) */
+        addi    5, 3, 1
+        sldi    5, 5, 3
+        add     5, 4, 5
+        LOAD_64BIT_VAL 10, operatingsystem_parameter_envp
+        std     5, 0(10)
+
+        bl      .__libc_init_first
+        nop
+
+        lis     3, _dl_fini@highest
+        ori     3, 3, _dl_fini@higher
+        sldi    3,3,32
+        oris    3, 3, _dl_fini@h
+        ori     3, 3, _dl_fini@l
+
+        bl      .PASCALMAIN
+        nop
+        ori     0, 0, 0
+
+        /* directly jump to exit procedure, not via the function pointer */
+        b       _haltproc
+
+        .align  3
+
+        .global ._haltproc
+        .section        ".opd", "aw"
+        .align 3
+._haltproc:
+        .quad   _haltproc, .TOC.@tocbase, 0
+        .previous
+        .size ._haltproc, 24
+        .global _haltproc
+
+_haltproc:
+        /* exit call */
+        li      0, 1
+        sc
+        b       _haltproc
+
+        /* Define a symbol for the first piece of initialized data.  */
+        .section ".data"
+        .globl  __data_start
+__data_start:
+data_start:
+        .globl  ___fpc_brk_addr /* heap management */
+        .type   ___fpc_brk_addr, @object
+        .size   ___fpc_brk_addr, 4
+___fpc_brk_addr:
+        .long   0
+
+.text
+        .comm operatingsystem_parameter_argc, 4
+        .comm operatingsystem_parameter_argv, 8
+        .comm operatingsystem_parameter_envp, 8
+        .comm operatingsystem_parameter_auxp, 8
+        .comm operatingsystem_parameter_exitp, 8
+

+ 8 - 0
rtl/linux/powerpc64/dllprt0.as

@@ -0,0 +1,8 @@
+/*
+*/
+
+/* empty */
+/*
+*/
+
+/* empty */

+ 10 - 0
rtl/linux/powerpc64/gprt0.as

@@ -0,0 +1,10 @@
+/*
+*/
+
+
+/* empty */
+/*
+*/
+
+
+/* empty */

+ 258 - 0
rtl/linux/powerpc64/prt0.as

@@ -0,0 +1,258 @@
+/*
+*/
+/* Startup code for programs linked with GNU libc.
+   Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library 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
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+   
+.macro LOAD_64BIT_VAL ra, value 
+	lis             \ra,\value@highest
+	ori             \ra,\ra,\value@higher
+	sldi            \ra,\ra,32
+	oris            \ra,\ra,\value@h
+	ori             \ra,\ra,\value@l	
+.endm
+
+.macro FUNCTION_PROLOG fn
+	.section	".text"
+	.align	2
+	.globl	\fn
+	.section	".opd", "aw"
+	.align	3
+	\fn:
+	.quad	.\fn, .TOC.@tocbase, 0
+	.previous
+	.size	\fn, 24
+	.type	\fn, @function	
+	.globl	.\fn
+.\fn:
+.endm
+
+.macro FUNCTION_EPILOG fn
+	.long	0
+	.byte	0, 12, 0, 0, 0, 0, 0, 0
+	.type	.\fn, @function
+	.size	.\fn,.-.\fn
+.endm
+
+.macro PRINTMSG msg len
+	lis	4, \msg@highest
+	ori	4, 4, \msg@higher
+	sldi	4, 4, 32
+	oris	4, 4, \msg@h
+	ori	4, 4, \msg@l	
+	li	5, \len	
+	li	0,4
+	li	3,1
+	sc
+.endm
+	/*
+        Main Pascal entry point label (function)
+	*/
+FUNCTION_PROLOG _start
+
+	mr 	26, 1
+	/* Set up an initial stack frame, and clear the LR */
+	clrrdi  1, 1, 5       /* align r1 */
+	li      0, 0          
+	stdu    1,-48(1)      
+	mtlr    0             
+	std     0, 0(1)       /* r1 = pointer to NULL value */
+
+	/* store argument count (= 0(r1) )*/
+	ld      3, 0(26)
+	LOAD_64BIT_VAL 10, operatingsystem_parameter_argc
+	stw     3, 0(10)
+	/* calculate argument vector address and store (= 8(r1) + 8 ) */
+	addi    4, 26, 8
+	LOAD_64BIT_VAL 10, operatingsystem_parameter_argv
+	std     4, 0(10)
+	/* store environment pointer (= argv + (argc+1)* 8 ) */
+	addi    5, 3, 1
+	sldi    5, 5, 3
+	add     5, 4, 5
+	LOAD_64BIT_VAL 10, operatingsystem_parameter_envp
+	std     5, 0(10)
+
+	bl      .PASCALMAIN
+	ori     0, 0, 0
+
+	/* directly jump to exit procedure, not via the function pointer */
+	b       ._haltproc
+	
+	.align  3
+
+	.global _haltproc
+	.section        ".opd", "aw"
+	.align 3
+_haltproc:
+	.quad   ._haltproc, .TOC.@tocbase, 0
+	.previous
+	.size _haltproc, 24
+	.global ._haltproc
+
+._haltproc:
+	/* exit call */
+	li      0, 1
+	sc
+	b       ._haltproc
+
+	/* Define a symbol for the first piece of initialized data.  */
+	.section ".data"
+	.globl  __data_start
+__data_start:
+data_start:
+	.globl  ___fpc_brk_addr	/* heap management */
+	.type   ___fpc_brk_addr, @object
+	.size   ___fpc_brk_addr, 4
+___fpc_brk_addr:
+	.long   0
+
+.text
+	.comm operatingsystem_parameter_argc, 4
+	.comm operatingsystem_parameter_argv, 8
+	.comm operatingsystem_parameter_envp, 8
+
+/*
+*/
+/* Startup code for programs linked with GNU libc.
+   Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+   This file is part of the GNU C Library.
+
+   The GNU C Library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU Lesser General Public
+   License as published by the Free Software Foundation; either
+   version 2.1 of the License, or (at your option) any later version.
+
+   The GNU C Library 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
+   Lesser General Public License for more details.
+
+   You should have received a copy of the GNU Lesser General Public
+   License along with the GNU C Library; if not, write to the Free
+   Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+   02111-1307 USA.  */
+
+.macro LOAD_64BIT_VAL ra, value
+        lis             \ra,\value@highest
+        ori             \ra,\ra,\value@higher
+        sldi            \ra,\ra,32
+        oris            \ra,\ra,\value@h
+        ori             \ra,\ra,\value@l
+.endm
+
+.macro FUNCTION_PROLOG fn
+        .section        ".text"
+        .align  2
+        .globl  \fn
+        .section        ".opd", "aw"
+        .align  3
+        \fn:
+        .quad   .\fn, .TOC.@tocbase, 0
+        .previous
+        .size   \fn, 24
+        .type   \fn, @function
+        .globl  .\fn
+.\fn:
+.endm
+
+.macro FUNCTION_EPILOG fn
+        .long   0
+        .byte   0, 12, 0, 0, 0, 0, 0, 0
+        .type   .\fn, @function
+        .size   .\fn,.-.\fn
+.endm
+
+.macro PRINTMSG msg len
+        lis     4, \msg@highest
+        ori     4, 4, \msg@higher
+        sldi    4, 4, 32
+        oris    4, 4, \msg@h
+        ori     4, 4, \msg@l
+        li      5, \len
+        li      0,4
+        li      3,1
+        sc
+.endm
+        /*
+        Main Pascal entry point label (function)
+        */
+FUNCTION_PROLOG _start
+
+        mr      26, 1
+        /* Set up an initial stack frame, and clear the LR */
+        clrrdi  1, 1, 5       /* align r1 */
+        li      0, 0
+        stdu    1,-48(1)
+        mtlr    0
+        std     0, 0(1)       /* r1 = pointer to NULL value */
+
+        /* store argument count (= 0(r1) )*/
+        ld      3, 0(26)
+        LOAD_64BIT_VAL 10, operatingsystem_parameter_argc
+        stw     3, 0(10)
+        /* calculate argument vector address and store (= 8(r1) + 8 ) */
+        addi    4, 26, 8
+        LOAD_64BIT_VAL 10, operatingsystem_parameter_argv
+        std     4, 0(10)
+        /* store environment pointer (= argv + (argc+1)* 8 ) */
+        addi    5, 3, 1
+        sldi    5, 5, 3
+        add     5, 4, 5
+        LOAD_64BIT_VAL 10, operatingsystem_parameter_envp
+        std     5, 0(10)
+
+        bl      .PASCALMAIN
+        ori     0, 0, 0
+
+        /* directly jump to exit procedure, not via the function pointer */
+        b       ._haltproc
+
+        .align  3
+
+        .global _haltproc
+        .section        ".opd", "aw"
+        .align 3
+_haltproc:
+        .quad   ._haltproc, .TOC.@tocbase, 0
+        .previous
+        .size _haltproc, 24
+        .global ._haltproc
+
+._haltproc:
+        /* exit call */
+        li      0, 1
+        sc
+        b       ._haltproc
+
+        /* Define a symbol for the first piece of initialized data.  */
+        .section ".data"
+        .globl  __data_start
+__data_start:
+data_start:
+        .globl  ___fpc_brk_addr /* heap management */
+        .type   ___fpc_brk_addr, @object
+        .size   ___fpc_brk_addr, 4
+___fpc_brk_addr:
+        .long   0
+
+.text
+        .comm operatingsystem_parameter_argc, 4
+        .comm operatingsystem_parameter_argv, 8
+        .comm operatingsystem_parameter_envp, 8
+

+ 104 - 0
rtl/linux/powerpc64/sighnd.inc

@@ -0,0 +1,104 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    Signal handler is arch dependant due to processor to language
+    exception conversion.
+
+    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.
+
+ **********************************************************************}
+
+
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+var
+  res : word;
+{  fpustate: longint; }
+begin
+  res:=0;
+  { exception flags are turned off by kernel }
+  fpc_enable_ppc_fpu_exceptions;
+  case sig of
+    SIGFPE :
+        begin
+{
+         fpscr is cleared by the kernel -> can't find out cause :(
+          fpustate := fpc_get_ppc_fpscr;
+          if (fpustate and ppc_fpu_underflow) <> 0 then
+            res := 206
+          else if (fpustate and ppc_fpu_overflow) <> 0 then
+            res := 205
+          else if (fpustate and ppc_fpu_divbyzero) <> 0 then
+            res := 200
+          else
+}
+            res := 207;
+        end;
+    SIGILL,
+    SIGBUS,
+    SIGSEGV :
+        res:=216;
+  end;
+  { give runtime error at the position where the signal was raised }
+  if res<>0 then
+    HandleErrorAddrFrame(res,pointer(SigContext^.pt_regs^.nip),pointer(SigContext^.pt_regs^.gpr[1]));
+end;
+
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    Signal handler is arch dependant due to processor to language
+    exception conversion.
+
+    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.
+
+ **********************************************************************}
+
+
+procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
+var
+  res : word;
+{  fpustate: longint; }
+begin
+  res:=0;
+  { exception flags are turned off by kernel }
+  fpc_enable_ppc_fpu_exceptions;
+  case sig of
+    SIGFPE :
+        begin
+{
+         fpscr is cleared by the kernel -> can't find out cause :(
+          fpustate := fpc_get_ppc_fpscr;
+          if (fpustate and ppc_fpu_underflow) <> 0 then
+            res := 206
+          else if (fpustate and ppc_fpu_overflow) <> 0 then
+            res := 205
+          else if (fpustate and ppc_fpu_divbyzero) <> 0 then
+            res := 200
+          else
+}
+            res := 207;
+        end;
+    SIGILL,
+    SIGBUS,
+    SIGSEGV :
+        res:=216;
+  end;
+  { give runtime error at the position where the signal was raised }
+  if res<>0 then
+    HandleErrorAddrFrame(res,pointer(SigContext^.pt_regs^.nip),pointer(SigContext^.pt_regs^.gpr[1]));
+end;
+

+ 158 - 0
rtl/linux/powerpc64/sighndh.inc

@@ -0,0 +1,158 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe,
+    member of the Free Pascal development team.
+
+    TSigContext
+
+    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.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+type
+  TPPC_Reg = QWord;
+  { from include/ppc/ptrace.h }
+  pptregs = ^tptregs;
+  tptregs = record
+    gpr: array[0..31] of TPPC_Reg;
+    nip: TPPC_Reg;
+    msr: TPPC_Reg;
+    orig_gpr3: TPPC_Reg; { Used for restarting system calls }
+    ctr: TPPC_Reg;
+    link: TPPC_Reg;
+    xer: TPPC_Reg;
+    ccr: TPPC_Reg;
+    mq: TPPC_Reg;        { 601 only (not used at present)  }
+                         { Used on APUS to hold IPL value. }
+    trap: TPPC_Reg;      { Reason for being here }
+    dar: TPPC_Reg;       { Fault registers }
+    dsisr: TPPC_Reg;
+    result: TPPC_Reg;    { Result of a system call }
+  end;
+
+  { from include/asm-ppc/signal.h }
+  stack_t = record
+    ss_sp: pointer;
+    ss_flags: longint;
+    ss_size: size_t;
+  end;
+
+  { from include/asm-ppc/sigcontext.h }
+  tsigcontext_struct = record
+    _unused: array[0..3] of PtrUInt;
+    signal: longint;
+    handler: PtrInt;
+    oldmask: PtrInt;
+    pt_regs: pptregs;
+  end;
+
+  { from include/asm-ppc/ucontext.h }
+  pucontext = ^tucontext;
+  tucontext = record
+    uc_flags : dword;
+    uc_link : pucontext;
+    uc_stack : stack_t;
+    uc_mcontext : tsigcontext_struct;
+    uc_sigmask : sigset_t;
+  end;
+
+
+  { from arch/ppc/kernel/signal.c, the type of the actual parameter passed }
+  { to the sigaction handler                                               }
+  t_rt_sigframe = record
+    _unused: array[0..1] of cardinal;
+    pinfo: psiginfo;
+    puc: pointer;
+    siginfo: tsiginfo;
+    uc: tucontext;
+  end;
+
+  PSigContext = ^TSigContext;
+  TSigContext= tsigcontext_struct;
+
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe,
+    member of the Free Pascal development team.
+
+    TSigContext
+
+    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.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+type
+  TPPC_Reg = QWord;
+  { from include/ppc/ptrace.h }
+  pptregs = ^tptregs;
+  tptregs = record
+    gpr: array[0..31] of TPPC_Reg;
+    nip: TPPC_Reg;
+    msr: TPPC_Reg;
+    orig_gpr3: TPPC_Reg; { Used for restarting system calls }
+    ctr: TPPC_Reg;
+    link: TPPC_Reg;
+    xer: TPPC_Reg;
+    ccr: TPPC_Reg;
+    mq: TPPC_Reg;        { 601 only (not used at present)  }
+                         { Used on APUS to hold IPL value. }
+    trap: TPPC_Reg;      { Reason for being here }
+    dar: TPPC_Reg;       { Fault registers }
+    dsisr: TPPC_Reg;
+    result: TPPC_Reg;    { Result of a system call }
+  end;
+
+  { from include/asm-ppc/signal.h }
+  stack_t = record
+    ss_sp: pointer;
+    ss_flags: longint;
+    ss_size: size_t;
+  end;
+
+  { from include/asm-ppc/sigcontext.h }
+  tsigcontext_struct = record
+    _unused: array[0..3] of PtrUInt;
+    signal: longint;
+    handler: PtrInt;
+    oldmask: PtrInt;
+    pt_regs: pptregs;
+  end;
+
+  { from include/asm-ppc/ucontext.h }
+  pucontext = ^tucontext;
+  tucontext = record
+    uc_flags : dword;
+    uc_link : pucontext;
+    uc_stack : stack_t;
+    uc_mcontext : tsigcontext_struct;
+    uc_sigmask : sigset_t;
+  end;
+
+
+  { from arch/ppc/kernel/signal.c, the type of the actual parameter passed }
+  { to the sigaction handler                                               }
+  t_rt_sigframe = record
+    _unused: array[0..1] of cardinal;
+    pinfo: psiginfo;
+    puc: pointer;
+    siginfo: tsiginfo;
+    uc: tucontext;
+  end;
+
+  PSigContext = ^TSigContext;
+  TSigContext= tsigcontext_struct;
+

+ 74 - 0
rtl/linux/powerpc64/stat.inc

@@ -0,0 +1,74 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe,
+    member of the Free Pascal development team.
+
+    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.
+
+ **********************************************************************}
+
+  Stat = packed record  // No unix typing because of differences
+    st_dev : qword;
+    st_ino : qword;
+    st_nlink : qword;
+
+    st_mode : dword;
+    st_uid : dword;
+    st_gid : dword;
+    __pad0 : dword;
+    st_rdev : qword;
+    st_size : int64;
+    st_blksize : int64;
+    st_blocks : int64;      { Number 512-byte blocks allocated. }
+
+    st_atime : qword;
+    __reserved0 : qword;    { reserved for atime.nanoseconds }
+    st_mtime : qword;
+    __reserved1 : qword;    { reserved for atime.nanoseconds }
+    st_ctime : qword;
+    __reserved2 : qword;    { reserved for atime.nanoseconds }
+    __unused : array[0..2] of int64;
+  end;
+
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe,
+    member of the Free Pascal development team.
+
+    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.
+
+ **********************************************************************}
+
+  Stat = packed record  // No unix typing because of differences
+    st_dev : qword;
+    st_ino : qword;
+    st_nlink : qword;
+
+    st_mode : dword;
+    st_uid : dword;
+    st_gid : dword;
+    __pad0 : dword;
+    st_rdev : qword;
+    st_size : int64;
+    st_blksize : int64;
+    st_blocks : int64;      { Number 512-byte blocks allocated. }
+
+    st_atime : qword;
+    __reserved0 : qword;    { reserved for atime.nanoseconds }
+    st_mtime : qword;
+    __reserved1 : qword;    { reserved for atime.nanoseconds }
+    st_ctime : qword;
+    __reserved2 : qword;    { reserved for atime.nanoseconds }
+    __unused : array[0..2] of int64;
+  end;
+

+ 742 - 0
rtl/linux/powerpc64/syscall.inc

@@ -0,0 +1,742 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    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.
+
+ **********************************************************************}
+
+{No debugging for syslinux include !}
+{$IFDEF SYS_LINUX}
+  {$UNDEF SYSCALL_DEBUG}
+{$ENDIF SYS_LINUX}
+
+
+{*****************************************************************************
+                     --- Main:The System Call Self ---
+*****************************************************************************}
+
+function FpSysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : longint;
+  retaddress: ptruint;
+asm
+  mr  r0,r3
+  sc
+  bns   .LDone
+  lis	r10,(fpc_threadvar_relocate_proc)@highesta
+  ori	r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi	r10, r10, 32
+  oris	r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld	r10,(fpc_threadvar_relocate_proc)@l(r10)
+  
+  cmpdi r10,0
+  bne   .LThreaded
+  lis	r4, (Errno+8)@highesta
+  ori	r4, r4, (Errno+8)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (Errno+8)@ha
+  stw	r3,(Errno+8)@l(r4)
+  b 	.LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori	r4, r4, (errno)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld	r3,(errno)@l(r4)
+  bctrl
+  ld	r4,temp
+  ld	r5,retaddress
+  std	r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li	r3, -1
+.LDone:
+end;
+
+function FpSysCall(sysnr,param1:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr	r0,r3
+  mr	r3,r4
+  sc
+  bns   .LDone
+  lis	r10,(fpc_threadvar_relocate_proc)@highesta
+  ori	r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi	r10, r10, 32
+  oris	r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld	r10,(fpc_threadvar_relocate_proc)@l(r10)
+  
+  cmpdi r10,0
+  bne   .LThreaded
+  lis	r4, (Errno+8)@highesta
+  ori	r4, r4, (Errno+8)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (Errno+8)@ha
+  stw	r3,(Errno+8)@l(r4)
+  b 	.LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori	r4, r4, (errno)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld	r3,(errno)@l(r4)
+  bctrl
+  ld	r4,temp
+  ld	r5,retaddress
+  std	r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li	r3, -1
+.LDone:
+end;
+
+function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr	r0,r3
+  mr	r3,r4
+  mr	r4,r5
+  sc
+  bns   .LDone
+  lis	r10,(fpc_threadvar_relocate_proc)@highesta
+  ori	r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi	r10, r10, 32
+  oris	r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld	r10,(fpc_threadvar_relocate_proc)@l(r10)
+  
+  cmpdi r10,0
+  bne   .LThreaded
+  lis	r4, (Errno+8)@highesta
+  ori	r4, r4, (Errno+8)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (Errno+8)@ha
+  stw	r3,(Errno+8)@l(r4)
+  b 	.LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori	r4, r4, (errno)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld	r3,(errno)@l(r4)
+  bctrl
+  ld	r4,temp
+  ld	r5,retaddress
+  std	r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li	r3, -1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr	r0,r3
+  mr	r3,r4
+  mr	r4,r5
+  mr	r5,r6
+  sc
+  bns   .LDone
+  lis	r10,(fpc_threadvar_relocate_proc)@highesta
+  ori	r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi	r10, r10, 32
+  oris	r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld	r10,(fpc_threadvar_relocate_proc)@l(r10)
+  
+  cmpdi r10,0
+  bne   .LThreaded
+  lis	r4, (Errno+8)@highesta
+  ori	r4, r4, (Errno+8)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (Errno+8)@ha
+  stw	r3,(Errno+8)@l(r4)
+  b 	.LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori	r4, r4, (errno)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld	r4,temp
+  ld	r5,retaddress
+  std	r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li	r3, -1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr	r0,r3
+  mr	r3,r4
+  mr	r4,r5
+  mr	r5,r6
+  mr	r6,r7
+  sc
+  bns   .LDone
+  lis	r10,(fpc_threadvar_relocate_proc)@highesta
+  ori	r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi	r10, r10, 32
+  oris	r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld	r10,(fpc_threadvar_relocate_proc)@l(r10)
+  
+  cmpdi r10,0
+  bne   .LThreaded
+  lis	r4, (Errno+8)@highesta
+  ori	r4, r4, (Errno+8)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (Errno+8)@ha
+  stw	r3,(Errno+8)@l(r4)
+  b 	.LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori	r4, r4, (errno)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld	r4,temp
+  ld	r5,retaddress
+  std	r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li	r3, -1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr	r0,r3
+  mr	r3,r4
+  mr	r4,r5
+  mr	r5,r6
+  mr	r6,r7
+  mr	r7,r8
+  sc
+  bns   .LDone
+  lis	r10,(fpc_threadvar_relocate_proc)@highesta
+  ori	r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi	r10, r10, 32
+  oris	r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld	r10,(fpc_threadvar_relocate_proc)@l(r10)
+  
+  cmpdi r10,0
+  bne   .LThreaded
+  lis	r4, (Errno+8)@highesta
+  ori	r4, r4, (Errno+8)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (Errno+8)@ha
+  stw	r3,(Errno+8)@l(r4)
+  b 	.LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori	r4, r4, (errno)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld	r4,temp
+  ld	r5,retaddress
+  std	r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li	r3, -1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr	r0,r3
+  mr	r3,r4
+  mr	r4,r5
+  mr	r5,r6
+  mr	r6,r7
+  mr	r7,r8
+  mr	r8,r9
+  sc
+  bns   .LDone
+  lis	r10,(fpc_threadvar_relocate_proc)@highesta
+  ori	r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi	r10, r10, 32
+  oris	r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld	r10,(fpc_threadvar_relocate_proc)@l(r10)
+  
+  cmpdi r10,0
+  bne   .LThreaded
+  lis	r4, (Errno+8)@highesta
+  ori	r4, r4, (Errno+8)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (Errno+8)@ha
+  stw	r3,(Errno+8)@l(r4)
+  b 	.LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori	r4, r4, (errno)@highera
+  sldi	r4, r4, 32
+  oris	r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld	r4,temp
+  ld	r5,retaddress
+  std	r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li	r3, -1
+.LDone:
+end;
+
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    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.
+
+ **********************************************************************}
+
+{No debugging for syslinux include !}
+{$IFDEF SYS_LINUX}
+  {$UNDEF SYSCALL_DEBUG}
+{$ENDIF SYS_LINUX}
+
+
+{*****************************************************************************
+                     --- Main:The System Call Self ---
+*****************************************************************************}
+
+function FpSysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : longint;
+  retaddress: ptruint;
+asm
+  mr  r0,r3
+  sc
+  bns   .LDone
+  lis   r10,(fpc_threadvar_relocate_proc)@highesta
+  ori   r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi  r10, r10, 32
+  oris  r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld    r10,(fpc_threadvar_relocate_proc)@l(r10)
+
+  cmpdi r10,0
+  bne   .LThreaded
+  lis   r4, (Errno+8)@highesta
+  ori   r4, r4, (Errno+8)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (Errno+8)@ha
+  stw   r3,(Errno+8)@l(r4)
+  b     .LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori   r4, r4, (errno)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld    r4,temp
+  ld    r5,retaddress
+  std   r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li    r3, -1
+.LDone:
+end;
+
+function FpSysCall(sysnr,param1:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr    r0,r3
+  mr    r3,r4
+  sc
+  bns   .LDone
+  lis   r10,(fpc_threadvar_relocate_proc)@highesta
+  ori   r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi  r10, r10, 32
+  oris  r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld    r10,(fpc_threadvar_relocate_proc)@l(r10)
+
+  cmpdi r10,0
+  bne   .LThreaded
+  lis   r4, (Errno+8)@highesta
+  ori   r4, r4, (Errno+8)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (Errno+8)@ha
+  stw   r3,(Errno+8)@l(r4)
+  b     .LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori   r4, r4, (errno)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld    r4,temp
+  ld    r5,retaddress
+  std   r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li    r3, -1
+.LDone:
+end;
+
+function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr    r0,r3
+  mr    r3,r4
+  mr    r4,r5
+  sc
+  bns   .LDone
+  lis   r10,(fpc_threadvar_relocate_proc)@highesta
+  ori   r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi  r10, r10, 32
+  oris  r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld    r10,(fpc_threadvar_relocate_proc)@l(r10)
+
+  cmpdi r10,0
+  bne   .LThreaded
+  lis   r4, (Errno+8)@highesta
+  ori   r4, r4, (Errno+8)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (Errno+8)@ha
+  stw   r3,(Errno+8)@l(r4)
+  b     .LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori   r4, r4, (errno)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld    r4,temp
+  ld    r5,retaddress
+  std   r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li    r3, -1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr    r0,r3
+  mr    r3,r4
+  mr    r4,r5
+  mr    r5,r6
+  sc
+  bns   .LDone
+  lis   r10,(fpc_threadvar_relocate_proc)@highesta
+  ori   r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi  r10, r10, 32
+  oris  r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld    r10,(fpc_threadvar_relocate_proc)@l(r10)
+
+  cmpdi r10,0
+  bne   .LThreaded
+  lis   r4, (Errno+8)@highesta
+  ori   r4, r4, (Errno+8)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (Errno+8)@ha
+  stw   r3,(Errno+8)@l(r4)
+  b     .LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori   r4, r4, (errno)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld    r4,temp
+  ld    r5,retaddress
+  std   r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li    r3, -1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr    r0,r3
+  mr    r3,r4
+  mr    r4,r5
+  mr    r5,r6
+  mr    r6,r7
+  sc
+  bns   .LDone
+  lis   r10,(fpc_threadvar_relocate_proc)@highesta
+  ori   r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi  r10, r10, 32
+  oris  r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld    r10,(fpc_threadvar_relocate_proc)@l(r10)
+
+  cmpdi r10,0
+  bne   .LThreaded
+  lis   r4, (Errno+8)@highesta
+  ori   r4, r4, (Errno+8)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (Errno+8)@ha
+  stw   r3,(Errno+8)@l(r4)
+  b     .LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori   r4, r4, (errno)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld    r4,temp
+  ld    r5,retaddress
+  std   r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li    r3, -1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr    r0,r3
+  mr    r3,r4
+  mr    r4,r5
+  mr    r5,r6
+  mr    r6,r7
+  mr    r7,r8
+  sc
+  bns   .LDone
+  lis   r10,(fpc_threadvar_relocate_proc)@highesta
+  ori   r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi  r10, r10, 32
+  oris  r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld    r10,(fpc_threadvar_relocate_proc)@l(r10)
+
+  cmpdi r10,0
+  bne   .LThreaded
+  lis   r4, (Errno+8)@highesta
+  ori   r4, r4, (Errno+8)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (Errno+8)@ha
+  stw   r3,(Errno+8)@l(r4)
+  b     .LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori   r4, r4, (errno)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld    r4,temp
+  ld    r5,retaddress
+  std   r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li    r3, -1
+.LDone:
+end;
+
+
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6'];
+{
+  This function puts the registers in place, does the call, and then
+  copies back the registers as they are after the SysCall.
+}
+var
+  temp : int64;
+  retaddress: ptruint;
+asm
+  mr    r0,r3
+  mr    r3,r4
+  mr    r4,r5
+  mr    r5,r6
+  mr    r6,r7
+  mr    r7,r8
+  mr    r8,r9
+  sc
+  bns   .LDone
+  lis   r10,(fpc_threadvar_relocate_proc)@highesta
+  ori   r10, r10, (fpc_threadvar_relocate_proc)@highera
+  sldi  r10, r10, 32
+  oris  r10, r10, (fpc_threadvar_relocate_proc)@ha
+  ld    r10,(fpc_threadvar_relocate_proc)@l(r10)
+
+  cmpdi r10,0
+  bne   .LThreaded
+  lis   r4, (Errno+8)@highesta
+  ori   r4, r4, (Errno+8)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (Errno+8)@ha
+  stw   r3,(Errno+8)@l(r4)
+  b     .LFailed
+.LThreaded:
+  std   r3,temp
+  mflr  r3
+  mtctr r10
+  lis   r4, (errno)@highesta
+  ori   r4, r4, (errno)@highera
+  sldi  r4, r4, 32
+  oris  r4, r4, (errno)@ha
+  std   r3,retaddress
+  ld    r3,(errno)@l(r4)
+  bctrl
+  ld    r4,temp
+  ld    r5,retaddress
+  std   r4,0(r3)
+  mtlr  r5
+.LFailed:
+  li    r3, -1
+.LDone:
+end;
+

+ 86 - 0
rtl/linux/powerpc64/syscallh.inc

@@ -0,0 +1,86 @@
+{
+    Copyright (c) 2002 by Marco van de Voort
+
+    Header for syscall in system unit for powerpc *nix.
+
+    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.
+
+ ****************************************************************************
+
+}
+
+Type
+
+  TSysResult = Int64;   // all platforms, cint=32-bit.
+                        // On platforms with off_t =64-bit, people should
+                        // use int64, and typecast all calls that don't
+                        // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+  TSysParam  = Int64;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult;  external name 'FPC_SYSCALL0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult;  external name 'FPC_SYSCALL2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  external name 'FPC_SYSCALL5';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult;  external name 'FPC_SYSCALL6';
+
+{
+    Copyright (c) 2002 by Marco van de Voort
+
+    Header for syscall in system unit for powerpc *nix.
+
+    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.
+
+ ****************************************************************************
+
+}
+
+Type
+
+  TSysResult = Int64;   // all platforms, cint=32-bit.
+                        // On platforms with off_t =64-bit, people should
+                        // use int64, and typecast all calls that don't
+                        // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+  TSysParam  = Int64;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult;  external name 'FPC_SYSCALL0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult;  external name 'FPC_SYSCALL2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  external name 'FPC_SYSCALL5';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult;  external name 'FPC_SYSCALL6';
+

+ 522 - 0
rtl/linux/powerpc64/sysnr.inc

@@ -0,0 +1,522 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    Syscall nrs for 2.4.18
+
+    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.
+
+ **********************************************************************}
+
+
+{
+* This file contains the system call numbers.
+}
+
+Const
+        syscall_nr_exit                 =  1;
+        syscall_nr_fork                 =  2;
+        syscall_nr_read                 =  3;
+        syscall_nr_write                =  4;
+        syscall_nr_open                 =  5;
+        syscall_nr_close                =  6;
+        syscall_nr_waitpid              =  7;
+        syscall_nr_creat                =  8;
+        syscall_nr_link                 =  9;
+        syscall_nr_unlink               = 10;
+        syscall_nr_execve               = 11;
+        syscall_nr_chdir                = 12;
+        syscall_nr_time                 = 13;
+        syscall_nr_mknod                = 14;
+        syscall_nr_chmod                = 15;
+        syscall_nr_lchown               = 16;
+        syscall_nr_break                = 17;
+        syscall_nr_oldstat              = 18;
+        syscall_nr_lseek                = 19;
+        syscall_nr_getpid               = 20;
+        syscall_nr_mount                = 21;
+        syscall_nr_umount               = 22;
+        syscall_nr_setuid               = 23;
+        syscall_nr_getuid               = 24;
+        syscall_nr_stime                = 25;
+        syscall_nr_ptrace               = 26;
+        syscall_nr_alarm                = 27;
+        syscall_nr_oldfstat             = 28;
+        syscall_nr_pause                = 29;
+        syscall_nr_utime                = 30;
+        syscall_nr_stty                 = 31;
+        syscall_nr_gtty                 = 32;
+        syscall_nr_access               = 33;
+        syscall_nr_nice                 = 34;
+        syscall_nr_ftime                = 35;
+        syscall_nr_sync                 = 36;
+        syscall_nr_kill                 = 37;
+        syscall_nr_rename               = 38;
+        syscall_nr_mkdir                = 39;
+        syscall_nr_rmdir                = 40;
+        syscall_nr_dup                  = 41;
+        syscall_nr_pipe                 = 42;
+        syscall_nr_times                = 43;
+        syscall_nr_prof                 = 44;
+        syscall_nr_brk                  = 45;
+        syscall_nr_setgid               = 46;
+        syscall_nr_getgid               = 47;
+        syscall_nr_signal               = 48;
+        syscall_nr_geteuid              = 49;
+        syscall_nr_getegid              = 50;
+        syscall_nr_acct                 = 51;
+        syscall_nr_umount2              = 52;
+        syscall_nr_lock                 = 53;
+        syscall_nr_ioctl                = 54;
+        syscall_nr_fcntl                = 55;
+        syscall_nr_mpx                  = 56;
+        syscall_nr_setpgid              = 57;
+        syscall_nr_ulimit               = 58;
+        syscall_nr_oldolduname          = 59;
+        syscall_nr_umask                = 60;
+        syscall_nr_chroot               = 61;
+        syscall_nr_ustat                = 62;
+        syscall_nr_dup2                 = 63;
+        syscall_nr_getppid              = 64;
+        syscall_nr_getpgrp              = 65;
+        syscall_nr_setsid               = 66;
+        syscall_nr_sigaction            = 67;
+        syscall_nr_sgetmask             = 68;
+        syscall_nr_ssetmask             = 69;
+        syscall_nr_setreuid             = 70;
+        syscall_nr_setregid             = 71;
+        syscall_nr_sigsuspend           = 72;
+        syscall_nr_sigpending           = 73;
+        syscall_nr_sethostname          = 74;
+        syscall_nr_setrlimit            = 75;
+        syscall_nr_getrlimit            = 76;   { Back compatible 2Gig limited rlimit }
+        syscall_nr_getrusage            = 77;
+        syscall_nr_gettimeofday         = 78;
+        syscall_nr_settimeofday         = 79;
+        syscall_nr_getgroups            = 80;
+        syscall_nr_setgroups            = 81;
+        syscall_nr_select               = 82;
+        syscall_nr_symlink              = 83;
+        syscall_nr_oldlstat             = 84;
+        syscall_nr_readlink             = 85;
+        syscall_nr_uselib               = 86;
+        syscall_nr_swapon               = 87;
+        syscall_nr_reboot               = 88;
+        syscall_nr_readdir              = 89;
+        syscall_nr_mmap                 = 90;
+        syscall_nr_munmap               = 91;
+        syscall_nr_truncate             = 92;
+        syscall_nr_ftruncate            = 93;
+        syscall_nr_fchmod               = 94;
+        syscall_nr_fchown               = 95;
+        syscall_nr_getpriority          = 96;
+        syscall_nr_setpriority          = 97;
+        syscall_nr_profil               = 98;
+        syscall_nr_statfs               = 99;
+        syscall_nr_fstatfs              = 100;
+        syscall_nr_ioperm               = 101;
+        syscall_nr_socketcall           = 102;
+        syscall_nr_syslog               = 103;
+        syscall_nr_setitimer            = 104;
+        syscall_nr_getitimer            = 105;
+        syscall_nr_stat                 = 106;
+        syscall_nr_lstat                = 107;
+        syscall_nr_fstat                = 108;
+        syscall_nr_olduname             = 109;
+        syscall_nr_iopl                 = 110;
+        syscall_nr_vhangup              = 111;
+        syscall_nr_idle                 = 112;
+        syscall_nr_vm86old              = 113;
+        syscall_nr_wait4                = 114;
+        syscall_nr_swapoff              = 115;
+        syscall_nr_sysinfo              = 116;
+        syscall_nr_ipc                  = 117;
+        syscall_nr_fsync                = 118;
+        syscall_nr_sigreturn            = 119;
+        syscall_nr_clone                = 120;
+        syscall_nr_setdomainname        = 121;
+        syscall_nr_uname                = 122;
+        syscall_nr_modify_ldt           = 123;
+        syscall_nr_adjtimex             = 124;
+        syscall_nr_mprotect             = 125;
+        syscall_nr_sigprocmask          = 126;
+        syscall_nr_create_module        = 127;
+        syscall_nr_init_module          = 128;
+        syscall_nr_delete_module        = 129;
+        syscall_nr_get_kernel_syms      = 130;
+        syscall_nr_quotactl             = 131;
+        syscall_nr_getpgid              = 132;
+        syscall_nr_fchdir               = 133;
+        syscall_nr_bdflush              = 134;
+        syscall_nr_sysfs                = 135;
+        syscall_nr_personality          = 136;
+        syscall_nr_afs_syscall          = 137; { Syscall for Andrew File System }
+        syscall_nr_setfsuid             = 138;
+        syscall_nr_setfsgid             = 139;
+        syscall_nr__llseek              = 140;
+        syscall_nr_getdents             = 141;
+        syscall_nr__newselect           = 142;
+        syscall_nr_flock                = 143;
+        syscall_nr_msync                = 144;
+        syscall_nr_readv                = 145;
+        syscall_nr_writev               = 146;
+        syscall_nr_getsid               = 147;
+        syscall_nr_fdatasync            = 148;
+        syscall_nr__sysctl              = 149;
+        syscall_nr_mlock                = 150;
+        syscall_nr_munlock              = 151;
+        syscall_nr_mlockall             = 152;
+        syscall_nr_munlockall           = 153;
+        syscall_nr_sched_setparam       = 154;
+        syscall_nr_sched_getparam       = 155;
+        syscall_nr_sched_setscheduler   = 156;
+        syscall_nr_sched_getscheduler   = 157;
+        syscall_nr_sched_yield          = 158;
+        syscall_nr_sched_get_priority_max       = 159;
+        syscall_nr_sched_get_priority_min       = 160;
+        syscall_nr_sched_rr_get_interval        = 161;
+        syscall_nr_nanosleep            = 162;
+        syscall_nr_mremap               = 163;
+        syscall_nr_setresuid            = 164;
+        syscall_nr_getresuid            = 165;
+        syscall_nr_vm86                 = 166;
+        syscall_nr_query_module         = 167;
+        syscall_nr_poll                 = 168;
+        syscall_nr_nfsservctl           = 169;
+        syscall_nr_setresgid            = 170;
+        syscall_nr_getresgid            = 171;
+        syscall_nr_prctl                = 172;
+        syscall_nr_rt_sigreturn         = 173;
+        syscall_nr_rt_sigaction         = 174;
+        syscall_nr_rt_sigprocmask       = 175;
+        syscall_nr_rt_sigpending        = 176;
+        syscall_nr_rt_sigtimedwait      = 177;
+        syscall_nr_rt_sigqueueinfo      = 178;
+        syscall_nr_rt_sigsuspend        = 179;
+        syscall_nr_pread                = 180;
+        syscall_nr_pwrite               = 181;
+        syscall_nr_chown                = 182;
+        syscall_nr_getcwd               = 183;
+        syscall_nr_capget               = 184;
+        syscall_nr_capset               = 185;
+        syscall_nr_sigaltstack          = 186;
+        syscall_nr_sendfile             = 187;
+        syscall_nr_getpmsg              = 188;  { some people actually want streams }
+        syscall_nr_putpmsg              = 189;  { some people actually want streams }
+        syscall_nr_vfork                = 190;
+        syscall_nr_ugetrlimit           = 191;  { SuS compliant getrlimit }
+        syscall_nr_mmap2                = 192;
+        syscall_nr_truncate64           = 193;
+        syscall_nr_ftruncate64          = 194;
+        syscall_nr_stat64               = 195;
+        syscall_nr_lstat64              = 196;
+        syscall_nr_fstat64              = 197;
+        syscall_nr_lchown32             = 198;
+        syscall_nr_getuid32             = 199;
+        syscall_nr_getgid32             = 200;
+        syscall_nr_geteuid32            = 201;
+        syscall_nr_getegid32            = 202;
+        syscall_nr_setreuid32           = 203;
+        syscall_nr_setregid32           = 204;
+        syscall_nr_getgroups32          = 205;
+        syscall_nr_setgroups32          = 206;
+        syscall_nr_fchown32             = 207;
+        syscall_nr_setresuid32          = 208;
+        syscall_nr_getresuid32          = 209;
+        syscall_nr_setresgid32          = 210;
+        syscall_nr_getresgid32          = 211;
+        syscall_nr_chown32              = 212;
+        syscall_nr_setuid32             = 213;
+        syscall_nr_setgid32             = 214;
+        syscall_nr_setfsuid32           = 215;
+        syscall_nr_setfsgid32           = 216;
+        syscall_nr_pivot_root           = 217;
+        syscall_nr_mincore              = 218;
+        syscall_nr_madvise              = 219;
+        syscall_nr_madvise1             = 219;  { delete when C lib stub is removed }
+        syscall_nr_getdents64           = 220;
+        syscall_nr_fcntl64              = 221;
+        syscall_nr_security             = 223;  { syscall for security modules }
+        syscall_nr_gettid               = 224;
+        syscall_nr_readahead            = 225;
+        syscall_nr_setxattr             = 226;
+        syscall_nr_lsetxattr            = 227;
+        syscall_nr_fsetxattr            = 228;
+        syscall_nr_getxattr             = 229;
+        syscall_nr_lgetxattr            = 230;
+        syscall_nr_fgetxattr            = 231;
+        syscall_nr_listxattr            = 232;
+        syscall_nr_llistxattr           = 233;
+        syscall_nr_flistxattr           = 234;
+        syscall_nr_removexattr          = 235;
+        syscall_nr_lremovexattr         = 236;
+        syscall_nr_fremovexattr         = 237;
+
+
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    Syscall nrs for 2.4.18
+
+    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.
+
+ **********************************************************************}
+
+
+{
+* This file contains the system call numbers.
+}
+
+Const
+        syscall_nr_exit                 =  1;
+        syscall_nr_fork                 =  2;
+        syscall_nr_read                 =  3;
+        syscall_nr_write                =  4;
+        syscall_nr_open                 =  5;
+        syscall_nr_close                =  6;
+        syscall_nr_waitpid              =  7;
+        syscall_nr_creat                =  8;
+        syscall_nr_link                 =  9;
+        syscall_nr_unlink               = 10;
+        syscall_nr_execve               = 11;
+        syscall_nr_chdir                = 12;
+        syscall_nr_time                 = 13;
+        syscall_nr_mknod                = 14;
+        syscall_nr_chmod                = 15;
+        syscall_nr_lchown               = 16;
+        syscall_nr_break                = 17;
+        syscall_nr_oldstat              = 18;
+        syscall_nr_lseek                = 19;
+        syscall_nr_getpid               = 20;
+        syscall_nr_mount                = 21;
+        syscall_nr_umount               = 22;
+        syscall_nr_setuid               = 23;
+        syscall_nr_getuid               = 24;
+        syscall_nr_stime                = 25;
+        syscall_nr_ptrace               = 26;
+        syscall_nr_alarm                = 27;
+        syscall_nr_oldfstat             = 28;
+        syscall_nr_pause                = 29;
+        syscall_nr_utime                = 30;
+        syscall_nr_stty                 = 31;
+        syscall_nr_gtty                 = 32;
+        syscall_nr_access               = 33;
+        syscall_nr_nice                 = 34;
+        syscall_nr_ftime                = 35;
+        syscall_nr_sync                 = 36;
+        syscall_nr_kill                 = 37;
+        syscall_nr_rename               = 38;
+        syscall_nr_mkdir                = 39;
+        syscall_nr_rmdir                = 40;
+        syscall_nr_dup                  = 41;
+        syscall_nr_pipe                 = 42;
+        syscall_nr_times                = 43;
+        syscall_nr_prof                 = 44;
+        syscall_nr_brk                  = 45;
+        syscall_nr_setgid               = 46;
+        syscall_nr_getgid               = 47;
+        syscall_nr_signal               = 48;
+        syscall_nr_geteuid              = 49;
+        syscall_nr_getegid              = 50;
+        syscall_nr_acct                 = 51;
+        syscall_nr_umount2              = 52;
+        syscall_nr_lock                 = 53;
+        syscall_nr_ioctl                = 54;
+        syscall_nr_fcntl                = 55;
+        syscall_nr_mpx                  = 56;
+        syscall_nr_setpgid              = 57;
+        syscall_nr_ulimit               = 58;
+        syscall_nr_oldolduname          = 59;
+        syscall_nr_umask                = 60;
+        syscall_nr_chroot               = 61;
+        syscall_nr_ustat                = 62;
+        syscall_nr_dup2                 = 63;
+        syscall_nr_getppid              = 64;
+        syscall_nr_getpgrp              = 65;
+        syscall_nr_setsid               = 66;
+        syscall_nr_sigaction            = 67;
+        syscall_nr_sgetmask             = 68;
+        syscall_nr_ssetmask             = 69;
+        syscall_nr_setreuid             = 70;
+        syscall_nr_setregid             = 71;
+        syscall_nr_sigsuspend           = 72;
+        syscall_nr_sigpending           = 73;
+        syscall_nr_sethostname          = 74;
+        syscall_nr_setrlimit            = 75;
+        syscall_nr_getrlimit            = 76;   { Back compatible 2Gig limited rlimit }
+        syscall_nr_getrusage            = 77;
+        syscall_nr_gettimeofday         = 78;
+        syscall_nr_settimeofday         = 79;
+        syscall_nr_getgroups            = 80;
+        syscall_nr_setgroups            = 81;
+        syscall_nr_select               = 82;
+        syscall_nr_symlink              = 83;
+        syscall_nr_oldlstat             = 84;
+        syscall_nr_readlink             = 85;
+        syscall_nr_uselib               = 86;
+        syscall_nr_swapon               = 87;
+        syscall_nr_reboot               = 88;
+        syscall_nr_readdir              = 89;
+        syscall_nr_mmap                 = 90;
+        syscall_nr_munmap               = 91;
+        syscall_nr_truncate             = 92;
+        syscall_nr_ftruncate            = 93;
+        syscall_nr_fchmod               = 94;
+        syscall_nr_fchown               = 95;
+        syscall_nr_getpriority          = 96;
+        syscall_nr_setpriority          = 97;
+        syscall_nr_profil               = 98;
+        syscall_nr_statfs               = 99;
+        syscall_nr_fstatfs              = 100;
+        syscall_nr_ioperm               = 101;
+        syscall_nr_socketcall           = 102;
+        syscall_nr_syslog               = 103;
+        syscall_nr_setitimer            = 104;
+        syscall_nr_getitimer            = 105;
+        syscall_nr_stat                 = 106;
+        syscall_nr_lstat                = 107;
+        syscall_nr_fstat                = 108;
+        syscall_nr_olduname             = 109;
+        syscall_nr_iopl                 = 110;
+        syscall_nr_vhangup              = 111;
+        syscall_nr_idle                 = 112;
+        syscall_nr_vm86old              = 113;
+        syscall_nr_wait4                = 114;
+        syscall_nr_swapoff              = 115;
+        syscall_nr_sysinfo              = 116;
+        syscall_nr_ipc                  = 117;
+        syscall_nr_fsync                = 118;
+        syscall_nr_sigreturn            = 119;
+        syscall_nr_clone                = 120;
+        syscall_nr_setdomainname        = 121;
+        syscall_nr_uname                = 122;
+        syscall_nr_modify_ldt           = 123;
+        syscall_nr_adjtimex             = 124;
+        syscall_nr_mprotect             = 125;
+        syscall_nr_sigprocmask          = 126;
+        syscall_nr_create_module        = 127;
+        syscall_nr_init_module          = 128;
+        syscall_nr_delete_module        = 129;
+        syscall_nr_get_kernel_syms      = 130;
+        syscall_nr_quotactl             = 131;
+        syscall_nr_getpgid              = 132;
+        syscall_nr_fchdir               = 133;
+        syscall_nr_bdflush              = 134;
+        syscall_nr_sysfs                = 135;
+        syscall_nr_personality          = 136;
+        syscall_nr_afs_syscall          = 137; { Syscall for Andrew File System }
+        syscall_nr_setfsuid             = 138;
+        syscall_nr_setfsgid             = 139;
+        syscall_nr__llseek              = 140;
+        syscall_nr_getdents             = 141;
+        syscall_nr__newselect           = 142;
+        syscall_nr_flock                = 143;
+        syscall_nr_msync                = 144;
+        syscall_nr_readv                = 145;
+        syscall_nr_writev               = 146;
+        syscall_nr_getsid               = 147;
+        syscall_nr_fdatasync            = 148;
+        syscall_nr__sysctl              = 149;
+        syscall_nr_mlock                = 150;
+        syscall_nr_munlock              = 151;
+        syscall_nr_mlockall             = 152;
+        syscall_nr_munlockall           = 153;
+        syscall_nr_sched_setparam       = 154;
+        syscall_nr_sched_getparam       = 155;
+        syscall_nr_sched_setscheduler   = 156;
+        syscall_nr_sched_getscheduler   = 157;
+        syscall_nr_sched_yield          = 158;
+        syscall_nr_sched_get_priority_max       = 159;
+        syscall_nr_sched_get_priority_min       = 160;
+        syscall_nr_sched_rr_get_interval        = 161;
+        syscall_nr_nanosleep            = 162;
+        syscall_nr_mremap               = 163;
+        syscall_nr_setresuid            = 164;
+        syscall_nr_getresuid            = 165;
+        syscall_nr_vm86                 = 166;
+        syscall_nr_query_module         = 167;
+        syscall_nr_poll                 = 168;
+        syscall_nr_nfsservctl           = 169;
+        syscall_nr_setresgid            = 170;
+        syscall_nr_getresgid            = 171;
+        syscall_nr_prctl                = 172;
+        syscall_nr_rt_sigreturn         = 173;
+        syscall_nr_rt_sigaction         = 174;
+        syscall_nr_rt_sigprocmask       = 175;
+        syscall_nr_rt_sigpending        = 176;
+        syscall_nr_rt_sigtimedwait      = 177;
+        syscall_nr_rt_sigqueueinfo      = 178;
+        syscall_nr_rt_sigsuspend        = 179;
+        syscall_nr_pread                = 180;
+        syscall_nr_pwrite               = 181;
+        syscall_nr_chown                = 182;
+        syscall_nr_getcwd               = 183;
+        syscall_nr_capget               = 184;
+        syscall_nr_capset               = 185;
+        syscall_nr_sigaltstack          = 186;
+        syscall_nr_sendfile             = 187;
+        syscall_nr_getpmsg              = 188;  { some people actually want streams }
+        syscall_nr_putpmsg              = 189;  { some people actually want streams }
+        syscall_nr_vfork                = 190;
+        syscall_nr_ugetrlimit           = 191;  { SuS compliant getrlimit }
+        syscall_nr_mmap2                = 192;
+        syscall_nr_truncate64           = 193;
+        syscall_nr_ftruncate64          = 194;
+        syscall_nr_stat64               = 195;
+        syscall_nr_lstat64              = 196;
+        syscall_nr_fstat64              = 197;
+        syscall_nr_lchown32             = 198;
+        syscall_nr_getuid32             = 199;
+        syscall_nr_getgid32             = 200;
+        syscall_nr_geteuid32            = 201;
+        syscall_nr_getegid32            = 202;
+        syscall_nr_setreuid32           = 203;
+        syscall_nr_setregid32           = 204;
+        syscall_nr_getgroups32          = 205;
+        syscall_nr_setgroups32          = 206;
+        syscall_nr_fchown32             = 207;
+        syscall_nr_setresuid32          = 208;
+        syscall_nr_getresuid32          = 209;
+        syscall_nr_setresgid32          = 210;
+        syscall_nr_getresgid32          = 211;
+        syscall_nr_chown32              = 212;
+        syscall_nr_setuid32             = 213;
+        syscall_nr_setgid32             = 214;
+        syscall_nr_setfsuid32           = 215;
+        syscall_nr_setfsgid32           = 216;
+        syscall_nr_pivot_root           = 217;
+        syscall_nr_mincore              = 218;
+        syscall_nr_madvise              = 219;
+        syscall_nr_madvise1             = 219;  { delete when C lib stub is removed }
+        syscall_nr_getdents64           = 220;
+        syscall_nr_fcntl64              = 221;
+        syscall_nr_security             = 223;  { syscall for security modules }
+        syscall_nr_gettid               = 224;
+        syscall_nr_readahead            = 225;
+        syscall_nr_setxattr             = 226;
+        syscall_nr_lsetxattr            = 227;
+        syscall_nr_fsetxattr            = 228;
+        syscall_nr_getxattr             = 229;
+        syscall_nr_lgetxattr            = 230;
+        syscall_nr_fgetxattr            = 231;
+        syscall_nr_listxattr            = 232;
+        syscall_nr_llistxattr           = 233;
+        syscall_nr_flistxattr           = 234;
+        syscall_nr_removexattr          = 235;
+        syscall_nr_lremovexattr         = 236;
+        syscall_nr_fremovexattr         = 237;
+
+

+ 18 - 0
rtl/powerpc64/int64p.inc

@@ -0,0 +1,18 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    This file contains some helper routines for int64 and qword
+
+    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.
+
+ **********************************************************************}
+
+
+
+

+ 310 - 0
rtl/powerpc64/math.inc

@@ -0,0 +1,310 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000 by Jonas Maebe and other members of the
+    Free Pascal development team
+
+    Implementation of mathematical Routines (only for real)
+
+    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.
+
+ **********************************************************************}
+
+
+const
+  longint_to_real_helper: int64 = $4330000080000000;
+  cardinal_to_real_helper: int64 = $4330000000000000;
+  int_to_real_factor: double = double(high(cardinal))+1.0;
+
+
+{****************************************************************************
+                       EXTENDED data type routines
+ ****************************************************************************}
+
+{$ifdef INTERNCONSTINTF}
+    {$define FPC_SYSTEM_HAS_PI}
+    function fpc_pi_real : valreal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
+
+    {$define FPC_SYSTEM_HAS_ABS}
+    function fpc_abs_real(d : valreal) : valreal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
+
+    {$define FPC_SYSTEM_HAS_SQR}
+    function fpc_sqr_real(d : valreal) : valreal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
+
+{$else}
+    {$define FPC_SYSTEM_HAS_PI}
+    function pi : double;[internproc:fpc_in_pi];
+
+    {$define FPC_SYSTEM_HAS_ABS}
+    function abs(d : extended) : extended;[internproc:fpc_in_abs_real];
+
+    {$define FPC_SYSTEM_HAS_SQR}
+    function sqr(d : extended) : extended;[internproc:fpc_in_sqr_real];
+{$endif ndef INTERNCONSTINTF}
+
+      const
+        factor: double = double(int64(1) shl 32);
+        factor2: double = double(int64(1) shl 31);
+(*
+{$ifndef FPC_SYSTEM_HAS_TRUNC}
+    {$define FPC_SYSTEM_HAS_TRUNC}
+    {$ifdef INTERNCONSTINTF}
+    function fpc_trunc_real(d : valreal) : int64;assembler;compilerproc;
+    {$else}
+    function trunc(d : extended) : int64;assembler;[internconst:fpc_in_const_trunc];
+    {$endif}
+      { input: d in fr1      }
+      { output: result in r3 }
+      assembler;
+      var
+        temp: packed record
+            case byte of
+              0: (l1,l2: longint);
+              1: (d: double);
+          end;
+      asm
+        // store d in temp
+        stfd    f1,temp
+        // extract sign bit (record in cr0)
+        lwz     r3,temp
+        rlwinm. r3,r3,1,31,31
+        // make d positive
+        fabs    f1,f1
+        // load 2^32 in f2
+        {$ifndef macos}
+        lis    r4,factor@ha
+        lfd    f2,factor@l(r4)
+        {$else}
+        lwz    r4,factor(r2)
+        lfd    f2,0(r4)
+        {$endif}
+        // check if value is < 0
+        // f3 := d / 2^32;
+        fdiv     f3,f1,f2
+        // round
+        fctiwz   f4,f3
+        // store
+        stfd     f4,temp
+        // and load into r4
+        lwz      r3,temp+4
+        // convert back to float
+        lis      r0,0x4330
+        stw      r0,temp
+        xoris    r0,r3,0x8000
+        stw      r0,temp+4
+        {$ifndef macos}
+        lis    r4,longint_to_real_helper@ha
+        lfd    f0,longint_to_real_helper@l(r4)
+        {$else}
+        lwz    r4,longint_to_real_helper(r2)
+        lfd    f0,0(r4)
+        {$endif}
+        lfd    f3,temp
+        fsub   f3,f3,f0
+
+
+        // f4 := d "mod" 2^32 ( = d - ((d / 2^32) * 2^32))
+        fnmsub   f4,f3,f2,f1
+
+        // now, convert to unsigned 32 bit
+
+        // load 2^31 in f2
+        {$ifndef macos}
+        lis    r4,factor2@ha
+        lfd    f2,factor2@l(r4)
+        {$else}
+        lwz    r4,factor2(r2)
+        lfd    f2,0(r4)
+        {$endif}
+
+        // subtract 2^31
+        fsub   f3,f4,f2
+        // was the value > 2^31?
+        fcmpu  cr1,f4,f2
+        // use diff if >= 2^31
+        fsel   f4,f3,f3,f4
+
+        // next part same as conversion to signed integer word
+        fctiwz f4,f4
+        stfd   f4,temp
+        lwz    r4,temp+4
+        // add 2^31 if value was >=2^31
+        blt    cr1, .LTruncNoAdd
+        xoris  r4,r4,0x8000
+.LTruncNoAdd:
+        // negate value if it was negative to start with
+        beq    cr0,.LTruncPositive
+        subfic r4,r4,0
+        subfze r3,r3
+.LTruncPositive:
+      end;
+{$endif not FPC_SYSTEM_HAS_TRUNC}
+*)
+
+(*
+{$ifndef FPC_SYSTEM_HAS_ROUND}
+    {$define FPC_SYSTEM_HAS_ROUND}
+{$ifdef hascompilerproc}
+    function round(d : extended) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round, external name 'FPC_ROUND'];{$endif}
+
+    function fpc_round(d : extended) : int64;assembler;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+{$else}
+    function round(d : extended) : int64;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif}
+{$endif hascompilerproc}
+      { exactly the same as trunc, except that one fctiwz has become fctiw }
+      { input: d in fr1      }
+      { output: result in r3 }
+      assembler;
+      var
+        temp: packed record
+            case byte of
+              0: (l1,l2: longint);
+              1: (d: double);
+          end;
+      asm
+        // store d in temp
+        stfd    f1, temp
+        // extract sign bit (record in cr0)
+        lwz     r4,temp
+        rlwinm. r4,r4,1,31,31
+        // make d positive
+        fabs    f1,f1
+        // load 2^32 in f2
+        {$ifndef macos}
+        lis    r4,factor@ha
+        lfd    f2,factor@l(r4)
+        {$else}
+        lwz    r4,factor(r2)
+        lfd    f2,0(r4)
+        {$endif}
+        // check if value is < 0
+        // f3 := d / 2^32;
+        fdiv     f3,f1,f2
+        // round
+        fctiwz   f4,f3
+        // store
+        stfd     f4,temp
+        // and load into r4
+        lwz      r3,temp+4
+        // convert back to float
+        lis      r0,0x4330
+        stw      r0,temp
+        xoris    r0,r3,0x8000
+        stw      r0,temp+4
+        {$ifndef macos}
+        lis    r4,longint_to_real_helper@ha
+        lfd    f0,longint_to_real_helper@l(r4)
+        {$else}
+        lwz    r4,longint_to_real_helper(r2)
+        lfd    f0,0(r4)
+        {$endif}
+        lfd    f3,temp
+        fsub   f3,f3,f0
+
+
+        // f4 := d "mod" 2^32 ( = d - ((d / 2^32) * 2^32))
+        fnmsub   f4,f3,f2,f1
+
+        // now, convert to unsigned 32 bit
+
+        // load 2^31 in f2
+        {$ifndef macos}
+        lis    r4,factor2@ha
+        lfd    f2,factor2@l(r4)
+        {$else}
+        lwz    r4,factor2(r2)
+        lfd    f2,0(r4)
+        {$endif}
+
+        // subtract 2^31
+        fsub   f3,f4,f2
+        // was the value > 2^31?
+        fcmpu  cr1,f4,f2
+        // use diff if >= 2^31
+        fsel   f4,f3,f3,f4
+
+        // next part same as conversion to signed integer word
+        fctiw  f4,f4
+        stfd   f4,temp
+        lwz    r4,temp+4
+        // add 2^31 if value was >=2^31
+        blt    cr1, .LRoundNoAdd
+        xoris  r4,r4,0x8000
+.LRoundNoAdd:
+        // negate value if it was negative to start with
+        beq    cr0,.LRoundPositive
+        subfic r4,r4,0
+        subfze r3,r3
+.LRoundPositive:
+      end;
+{$endif not FPC_SYSTEM_HAS_ROUND}
+*)
+
+
+{****************************************************************************
+                         Int to real helpers
+ ****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_INT64_TO_DOUBLE}
+function fpc_int64_to_double(i: int64): double; compilerproc;
+assembler;
+{ input: i in r3 }
+{ output: double(i) in f0            }
+{from "PowerPC Microprocessor Family: Programming Environments Manual for 64 and 32-Bit Microprocessors", v2.0, pg. 698 }
+var temp : int64;
+asm
+        std r3,temp // store dword
+        lfd f0,temp // load float
+        fcfid f0,f0     // convert to fpu int
+end;
+
+
+{$define FPC_SYSTEM_HAS_QWORD_TO_DOUBLE}
+function fpc_qword_to_double(q: qword): double; compilerproc;
+assembler;
+const
+  longint_to_real_helper: qword = $80000000;
+{from "PowerPC Microprocessor Family: Programming Environments Manual for
+ 64 and 32-Bit Microprocessors", v2.0, pg. 698, *exact version*              }
+{ input: q in r3 }
+{ output: double(q) in f0            }
+var
+  temp1, temp2: qword;
+asm
+    // load 2^32 into f4
+        lis   r4, longint_to_real_helper@highesta
+        ori   r4, r4, longint_to_real_helper@highera
+        sldi  r4, r4, 32
+        oris  r4, r4, longint_to_real_helper@ha
+        lfd   f4, longint_to_real_helper@l(r4)
+
+        rldicl r4,r3,32,32  // isolate high half
+        rldicl r0,r3,0,32   // isolate low half
+        std r4,temp1        // store dword both
+        std r0,temp2
+        lfd f2,temp1        // load float both
+        lfd f0,temp2        // load float both
+        fcfid f2,f2         // convert each half to
+        fcfid f0,f0         // fpu int (no rnd)
+        fmadd f0,f4,f2,f0   // (2**32)*high+low (only add can rnd)
+end;
+

+ 13 - 0
rtl/powerpc64/mathu.inc

@@ -0,0 +1,13 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
+
+    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.
+
+ **********************************************************************}

+ 14 - 0
rtl/powerpc64/mathuh.inc

@@ -0,0 +1,14 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
+
+    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.
+
+ **********************************************************************}
+

+ 1071 - 0
rtl/powerpc64/powerpc.inc

@@ -0,0 +1,1071 @@
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000-2001 by the Free Pascal development team.
+
+    Portions Copyright (c) 2000 by Casey Duncan ([email protected])
+
+    Processor dependent implementation for the system unit for
+    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.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+                           PowerPC specific stuff
+****************************************************************************}
+{
+const
+  ppc_fpu_overflow     = (1 shl (32-3));
+  ppc_fpu_underflow    = (1 shl (32-4));
+  ppc_fpu_divbyzero    = (1 shl (32-5));
+  ppc_fpu_inexact      = (1 shl (32-6));
+  ppc_fpu_invalid_snan = (1 shl (32-7));
+}
+
+procedure fpc_enable_ppc_fpu_exceptions;
+assembler; nostackframe;
+asm
+  { clear all "exception happened" flags we care about}
+  mtfsfi 0,0
+  mtfsfi 1,0
+  mtfsfi 2,0
+  mtfsfi 3,0
+{$ifdef fpc_mtfsb0_corrected}
+  mtfsb0 21
+  mtfsb0 22
+  mtfsb0 23
+
+{$endif fpc_mtfsb0_corrected}
+
+  { enable invalid operations and division by zero exceptions. }
+  { No overflow/underflow, since those give some spurious      }
+  { exceptions                                                 }
+  mtfsfi 6,9
+end;
+
+
+procedure fpc_cpuinit;
+begin
+  fpc_enable_ppc_fpu_exceptions;
+end;
+
+
+function fpc_get_ppc_fpscr: cardinal;
+assembler;
+var
+  temp: record a,b:longint; end;
+asm
+  mffs f0
+  stfd f0,temp
+  lwz  r3,temp.b
+  { clear all exception flags }
+{
+  rlwinm r4,r3,0,16,31
+  stw  r4,temp.b
+  lfd  f0,temp
+  a_mtfsf f0
+}
+end;
+
+
+{ note: unused}
+{ The following code is never called directly, it's a dummy which holds the
+entry points and code to the register save/load subroutines; it is part of the
+PPC ABI and used in procedure entry and exit methods.
+See the comments in the code for "calling conventions". Directly taken from
+the ABI specification. The labels right below are required to shut up the
+compiler. }
+
+label
+        // _savegpr0_x
+        _savegpr0_14, _savegpr0_15, _savegpr0_16, _savegpr0_17, _savegpr0_18, _savegpr0_19,
+        _savegpr0_20, _savegpr0_21, _savegpr0_22, _savegpr0_23, _savegpr0_24, _savegpr0_25,
+        _savegpr0_26, _savegpr0_27, _savegpr0_28, _savegpr0_29, _savegpr0_30, _savegpr0_31,
+        // _restgpr0_x
+        _restgpr0_14, _restgpr0_15, _restgpr0_16, _restgpr0_17, _restgpr0_18, _restgpr0_19,
+        _restgpr0_20, _restgpr0_21, _restgpr0_22, _restgpr0_23, _restgpr0_24, _restgpr0_25,
+        _restgpr0_26, _restgpr0_27, _restgpr0_28, _restgpr0_29, _restgpr0_30, _restgpr0_31,
+        // _savegpr1_x
+        _savegpr1_14, _savegpr1_15, _savegpr1_16, _savegpr1_17, _savegpr1_18, _savegpr1_19,
+        _savegpr1_20, _savegpr1_21, _savegpr1_22, _savegpr1_23, _savegpr1_24, _savegpr1_25,
+        _savegpr1_26, _savegpr1_27, _savegpr1_28, _savegpr1_29, _savegpr1_30, _savegpr1_31,
+        // _restgpr1_x
+        _restgpr1_14, _restgpr1_15, _restgpr1_16, _restgpr1_17, _restgpr1_18, _restgpr1_19,
+        _restgpr1_20, _restgpr1_21, _restgpr1_22, _restgpr1_23, _restgpr1_24, _restgpr1_25,
+        _restgpr1_26, _restgpr1_27, _restgpr1_28, _restgpr1_29, _restgpr1_30, _restgpr1_31,
+        // _savefpr_x
+        _savefpr_14, _savefpr_15, _savefpr_16, _savefpr_17, _savefpr_18, _savefpr_19,
+        _savefpr_20, _savefpr_21, _savefpr_22, _savefpr_23, _savefpr_24, _savefpr_25,
+        _savefpr_26, _savefpr_27, _savefpr_28, _savefpr_29, _savefpr_30, _savefpr_31,
+        // _restfpr_x
+        _restfpr_14, _restfpr_15, _restfpr_16, _restfpr_17, _restfpr_18, _restfpr_19,
+        _restfpr_20, _restfpr_21, _restfpr_22, _restfpr_23, _restfpr_24, _restfpr_25,
+        _restfpr_26, _restfpr_27, _restfpr_28, _restfpr_29, _restfpr_30, _restfpr_31,
+        // _savevr_x
+        _savevr_20, _savevr_21, _savevr_22, _savevr_23, _savevr_24, _savevr_25,
+        _savevr_26, _savevr_27, _savevr_28, _savevr_29, _savevr_30, _savevr_31,
+        // _restvr_x
+        _restvr_20, _restvr_21, _restvr_22, _restvr_23, _restvr_24, _restvr_25,
+        _restvr_26, _restvr_27, _restvr_28, _restvr_29, _restvr_30, _restvr_31;
+
+
+procedure __save_restore_services; assembler; nostackframe;
+assembler;
+asm
+// Each _savegpr0_N routine saves the general registers from rN to r31, inclusive.
+// Each routine also saves the LR. When the routine is called, r1 must point to
+// the start of the general register save area, and r0 must contain the
+// value of LR on function entry.
+.globl _savegpr0_14
+_savegpr0_14: std r14,-144(r1)
+.globl _savegpr0_15
+_savegpr0_15: std r15,-136(r1)
+.globl _savegpr0_16
+_savegpr0_16: std r16,-128(r1)
+.globl _savegpr0_17
+_savegpr0_17: std r17,-120(r1)
+.globl _savegpr0_18
+_savegpr0_18: std r18,-112(r1)
+.globl _savegpr0_19
+_savegpr0_19: std r19,-104(r1)
+.globl _savegpr0_20
+_savegpr0_20: std r20,-96(r1)
+.globl _savegpr0_21
+_savegpr0_21: std r21,-88(r1)
+.globl _savegpr0_22
+_savegpr0_22: std r22,-80(r1)
+.globl _savegpr0_23
+_savegpr0_23: std r23,-72(r1)
+.globl _savegpr0_24
+_savegpr0_24: std r24,-64(r1)
+.globl _savegpr0_25
+_savegpr0_25: std r25,-56(r1)
+.globl _savegpr0_26
+_savegpr0_26: std r26,-48(r1)
+.globl _savegpr0_27
+_savegpr0_27: std r27,-40(r1)
+.globl _savegpr0_28
+_savegpr0_28: std r28,-32(r1)
+.globl _savegpr0_29
+_savegpr0_29: std r29,-24(r1)
+.globl _savegpr0_30
+_savegpr0_30: std r30,-16(r1)
+.globl _savegpr0_31
+_savegpr0_31: std r31,-8(r1)
+        std r0, 16(r1)
+        blr
+// The _restgpr0_N routines restore the general registers from rN to r31, and then
+// return to the caller. When the routine is called, r1 must point to the start of
+// the general register save area.
+.globl _restgpr0_14
+_restgpr0_14: ld r14,-144(r1)
+.globl _restgpr0_15
+_restgpr0_15: ld r15,-136(r1)
+.globl _restgpr0_16
+_restgpr0_16: ld r16,-128(r1)
+.globl _restgpr0_17
+_restgpr0_17: ld r17,-120(r1)
+.globl _restgpr0_18
+_restgpr0_18: ld r18,-112(r1)
+.globl _restgpr0_19
+_restgpr0_19: ld r19,-104(r1)
+.globl _restgpr0_20
+_restgpr0_20: ld r20,-96(r1)
+.globl _restgpr0_21
+_restgpr0_21: ld r21,-88(r1)
+.globl _restgpr0_22
+_restgpr0_22: ld r22,-80(r1)
+.globl _restgpr0_23
+_restgpr0_23: ld r23,-72(r1)
+.globl _restgpr0_24
+_restgpr0_24: ld r24,-64(r1)
+.globl _restgpr0_25
+_restgpr0_25: ld r25,-56(r1)
+.globl _restgpr0_26
+_restgpr0_26: ld r26,-48(r1)
+.globl _restgpr0_27
+_restgpr0_27: ld r27,-40(r1)
+.globl _restgpr0_28
+_restgpr0_28: ld r28,-32(r1)
+.globl _restgpr0_29
+_restgpr0_29: ld r0, 16(r1)
+        ld r29,-24(r1)
+        mtlr r0
+        ld r30,-16(r1)
+        ld r31,-8(r1)
+        blr
+.globl _restgpr0_30
+_restgpr0_30: ld r30,-16(r1)
+.globl _restgpr0_31
+_restgpr0_31: ld r0, 16(r1)
+        ld r31,-8(r1)
+        mtlr r0
+        blr
+// Each _savegpr1_N routine saves the general registers from rN to r31,
+// inclusive. When the routine is called, r12
+// must point to the start of the general register save area.
+.globl _savegpr1_14
+_savegpr1_14: std r14,-144(r12)
+.globl _savegpr1_15
+_savegpr1_15: std r15,-136(r12)
+.globl _savegpr1_16
+_savegpr1_16: std r16,-128(r12)
+.globl _savegpr1_17
+_savegpr1_17: std r17,-120(r12)
+.globl _savegpr1_18
+_savegpr1_18: std r18,-112(r12)
+.globl _savegpr1_19
+_savegpr1_19: std r19,-104(r12)
+.globl _savegpr1_20
+_savegpr1_20: std r20,-96(r12)
+.globl _savegpr1_21
+_savegpr1_21: std r21,-88(r12)
+.globl _savegpr1_22
+_savegpr1_22: std r22,-80(r12)
+.globl _savegpr1_23
+_savegpr1_23: std r23,-72(r12)
+.globl _savegpr1_24
+_savegpr1_24: std r24,-64(r12)
+.globl _savegpr1_25
+_savegpr1_25: std r25,-56(r12)
+.globl _savegpr1_26
+_savegpr1_26: std r26,-48(r12)
+.globl _savegpr1_27
+_savegpr1_27: std r27,-40(r12)
+.globl _savegpr1_28
+_savegpr1_28: std r28,-32(r12)
+.globl _savegpr1_29
+_savegpr1_29: std r29,-24(r12)
+.globl _savegpr1_30
+_savegpr1_30: std r30,-16(r12)
+.globl _savegpr1_31
+_savegpr1_31: std r31,-8(r12)
+        blr
+// The _restgpr1_N routines restore the general registers from rN to r31.
+// When the routine is called, r12 must point to the start of the general
+// register save area.
+.globl _restgpr1_14
+_restgpr1_14: ld r14,-144(r12)
+.globl _restgpr1_15
+_restgpr1_15: ld r15,-136(r12)
+.globl _restgpr1_16
+_restgpr1_16: ld r16,-128(r12)
+.globl _restgpr1_17
+_restgpr1_17: ld r17,-120(r12)
+.globl _restgpr1_18
+_restgpr1_18: ld r18,-112(r12)
+.globl _restgpr1_19
+_restgpr1_19: ld r19,-104(r12)
+.globl _restgpr1_20
+_restgpr1_20: ld r20,-96(r12)
+.globl _restgpr1_21
+_restgpr1_21: ld r21,-88(r12)
+.globl _restgpr1_22
+_restgpr1_22: ld r22,-80(r12)
+.globl _restgpr1_23
+_restgpr1_23: ld r23,-72(r12)
+.globl _restgpr1_24
+_restgpr1_24: ld r24,-64(r12)
+.globl _restgpr1_25
+_restgpr1_25: ld r25,-56(r12)
+.globl _restgpr1_26
+_restgpr1_26: ld r26,-48(r12)
+.globl _restgpr1_27
+_restgpr1_27: ld r27,-40(r12)
+.globl _restgpr1_28
+_restgpr1_28: ld r28,-32(r12)
+.globl _restgpr1_29
+_restgpr1_29: ld r29,-24(r12)
+.globl _restgpr1_30
+_restgpr1_30: ld r30,-16(r12)
+.globl _restgpr1_31
+_restgpr1_31: ld r31,-8(r12)
+        blr
+
+// Each _savefpr_M routine saves the floating point registers from fM to f31,
+// inclusive. When the routine is called, r1 must point to the start of the
+// floating point register save area, and r0 must contain the value of LR on
+// function entry.
+_savefpr_14: stfd f14,-144(r1)
+_savefpr_15: stfd f15,-136(r1)
+_savefpr_16: stfd f16,-128(r1)
+_savefpr_17: stfd f17,-120(r1)
+_savefpr_18: stfd f18,-112(r1)
+_savefpr_19: stfd f19,-104(r1)
+_savefpr_20: stfd f20,-96(r1)
+_savefpr_21: stfd f21,-88(r1)
+_savefpr_22: stfd f22,-80(r1)
+_savefpr_23: stfd f23,-72(r1)
+_savefpr_24: stfd f24,-64(r1)
+_savefpr_25: stfd f25,-56(r1)
+_savefpr_26: stfd f26,-48(r1)
+_savefpr_27: stfd f27,-40(r1)
+_savefpr_28: stfd f28,-32(r1)
+_savefpr_29: stfd f29,-24(r1)
+_savefpr_30: stfd f30,-16(r1)
+_savefpr_31: stfd f31,-8(r1)
+        std r0, 16(r1)
+        blr
+// The _restfpr_M routines restore the floating point registers from fM to f31.
+// When the routine is called, r1 must point to the start of the floating point
+// register save area.
+_restfpr_14: lfd f14,-144(r1)
+_restfpr_15: lfd f15,-136(r1)
+_restfpr_16: lfd f16,-128(r1)
+_restfpr_17: lfd f17,-120(r1)
+_restfpr_18: lfd f18,-112(r1)
+_restfpr_19: lfd f19,-104(r1)
+_restfpr_20: lfd f20,-96(r1)
+_restfpr_21: lfd f21,-88(r1)
+_restfpr_22: lfd f22,-80(r1)
+_restfpr_23: lfd f23,-72(r1)
+_restfpr_24: lfd f24,-64(r1)
+_restfpr_25: lfd f25,-56(r1)
+_restfpr_26: lfd f26,-48(r1)
+_restfpr_27: lfd f27,-40(r1)
+_restfpr_28: lfd f28,-32(r1)
+_restfpr_29: lfd f29,-24(r1)
+_restfpr_29: ld r0, 16(r1)
+        lfd f29,-24(r1)
+        mtlr r0
+        lfd f30,-16(r1)
+        lfd f31,-8(r1)
+        blr
+_restfpr_30: lfd f30,-16(r1)
+_restfpr_31: ld r0, 16(r1)
+        lfd f31,-8(r1)
+        mtlr r0
+        blr
+// Each _savevr_M routine saves the vector registers from vM to v31, inclusive.
+// When the routine is called, r0 must point to the word just beyound the end
+// of the vector register save area. On return the value of r0 is unchanged
+// while r12 may be modified.
+(* commented out: GAS does not understand VMX opcodes?
+_savevr_20: addi r12,r0,-192
+        stvx v20,r12,r0
+_savevr_21: addi r12,r0,-176
+        stvx v21,r12,r0
+_savevr_22: addi r12,r0,-160
+        stvx v22,r12,r0
+_savevr_23: addi r12,r0,-144
+        stvx v23,r12,r0
+_savevr_24: addi r12,r0,-128
+        stvx v24,r12,r0
+_savevr_25: addi r12,r0,-112
+        stvx v25,r12,r0
+_savevr_26: addi r12,r0,-96
+        stvx v26,r12,r0
+_savevr_27: addi r12,r0,-80
+        stvx v27,r12,r0
+_savevr_28: addi r12,r0,-64
+        stvx v28,r12,r0
+_savevr_29: addi r12,r0,-48
+        stvx v29,r12,r0
+_savevr_30: addi r12,r0,-32
+        stvx v30,r12,r0
+_savevr_31: addi r12,r0,-16
+        stvx v31,r12,r0
+        blr
+*)
+// The _restvr_M routines restore the vector registers from vM to v31. When the
+// routine is called, r0 must point to the word just beyound the end of the
+// vector register save area. On return the value of r0 is unchanged while r12
+// may be modified.
+(* commented out: GAS does not understand VMX opcodes?
+_restvr_20: addi r12,r0,-192
+        lvx v20,r12,r0
+_restvr_21: addi r12,r0,-176
+        lvx v21,r12,r0
+_restvr_22: addi r12,r0,-160
+        lvx v22,r12,r0
+_restvr_23: addi r12,r0,-144
+        lvx v23,r12,r0
+_restvr_24: addi r12,r0,-128
+        lvx v24,r12,r0
+_restvr_25: addi r12,r0,-112
+        lvx v25,r12,r0
+_restvr_26: addi r12,r0,-96
+        lvx v26,r12,r0
+_restvr_27: addi r12,r0,-80
+        lvx v27,r12,r0
+_restvr_28: addi r12,r0,-64
+        lvx v28,r12,r0
+_restvr_29: addi r12,r0,-48
+        lvx v29,r12,r0
+_restvr_30: addi r12,r0,-32
+        lvx v30,r12,r0
+_restvr_31: addi r12,r0,-16
+        lvx v31,r12,r0
+        blr
+*)
+end;
+
+
+{****************************************************************************
+                                Move / Fill
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_MOVE}
+{$define FPC_SYSTEM_HAS_MOVE}
+procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];
+type
+  bytearray    = array [0..high(sizeint)-1] of byte;
+var
+  i:longint;
+begin
+  if count <= 0 then exit;
+  Dec(count);
+  if @source<@dest then
+    begin
+      for i:=count downto 0 do
+        bytearray(dest)[i]:=bytearray(source)[i];
+    end
+  else
+    begin
+      for i:=0 to count do
+        bytearray(dest)[i]:=bytearray(source)[i];
+    end;
+end;
+{$endif FPC_SYSTEM_HAS_MOVE}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
+{$define FPC_SYSTEM_HAS_FILLCHAR}
+
+Procedure FillChar(var x;count:SizeInt;value:byte);
+type
+  longintarray = array [0..high(sizeint) div 4-1] of longint;
+  bytearray    = array [0..high(sizeint)-1] of byte;
+var
+  i,v : longint;
+begin
+  if count <= 0 then exit;
+  v := 0;
+  { aligned? }
+  if (PtrUInt(@x) mod sizeof(PtrUInt))<>0 then
+    begin
+      for i:=0 to count-1 do
+        bytearray(x)[i]:=value;
+    end
+  else
+    begin
+      v:=(value shl 8) or (value and $FF);
+      v:=(v shl 16) or (v and $ffff);
+      for i:=0 to (count div 4)-1 do
+        longintarray(x)[i]:=v;
+      for i:=(count div 4)*4 to count-1 do
+        bytearray(x)[i]:=value;
+    end;
+end;
+{$endif FPC_SYSTEM_HAS_FILLCHAR}
+
+
+{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
+{$define FPC_SYSTEM_HAS_FILLDWORD}
+procedure filldword(var x;count : SizeInt;value : dword);
+assembler; nostackframe;
+asm
+{       registers:
+        r3              x
+        r4              count
+        r5              value
+}
+                cmpdi   cr0,r4,0
+                mtctr   r4
+                subi    r3,r3,4
+                ble    .LFillDWordEnd    //if count<=0 Then Exit
+.LFillDWordLoop:
+                stwu    r5,4(r3)
+                bdnz    .LFillDWordLoop
+.LFillDWordEnd:
+end;
+{$endif FPC_SYSTEM_HAS_FILLDWORD}
+
+(*
+{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
+{$define FPC_SYSTEM_HAS_INDEXBYTE}
+function IndexByte(const buf;len:SizeInt;b:byte):int64; assembler; nostackframe;
+{ input: r3 = buf, r4 = len, r5 = b                   }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+                {  load the begin of the buffer in the data cache }
+                dcbt    0,r3
+                cmplwi  r4,0
+                mtctr   r4
+                subi    r10,r3,1
+                mr      r0,r3
+                { assume not found }
+                li      r3,-1
+                ble     .LIndexByteDone
+.LIndexByteLoop:
+                lbzu    r9,1(r10)
+                cmplw   r9,r5
+                bdnzf   cr0*4+eq,.LIndexByteLoop
+                { r3 still contains -1 here }
+                bne     .LIndexByteDone
+                sub     r3,r10,r0
+.LIndexByteDone:
+end;
+{$endif FPC_SYSTEM_HAS_INDEXBYTE}
+*)
+(*
+{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
+{$define FPC_SYSTEM_HAS_INDEXWORD}
+function IndexWord(const buf;len:SizeInt;b:word):int64; assembler; nostackframe;
+{ input: r3 = buf, r4 = len, r5 = b                   }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+                {  load the begin of the buffer in the data cache }
+                dcbt    0,r3
+                cmplwi  r4,0
+                mtctr   r4
+                subi    r10,r3,2
+                mr      r0,r3
+                { assume not found }
+                li      r3,-1
+                ble     .LIndexWordDone
+.LIndexWordLoop:
+                lhzu    r9,2(r10)
+                cmplw   r9,r5
+                bdnzf   cr0*4+eq,.LIndexWordLoop
+                { r3 still contains -1 here }
+                bne     .LIndexWordDone
+                sub     r3,r10,r0
+                srawi   r3,r3,1
+.LIndexWordDone:
+end;
+{$endif FPC_SYSTEM_HAS_INDEXWORD}
+*)
+(*
+{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
+{$define FPC_SYSTEM_HAS_INDEXDWORD}
+function IndexDWord(const buf;len:SizeInt;b:DWord):int64; assembler; nostackframe;
+{ input: r3 = buf, r4 = len, r5 = b                   }
+{ output: r3 = position of b in buf (-1 if not found) }
+asm
+                {  load the begin of the buffer in the data cache }
+                dcbt    0,r3
+                cmplwi  r4,0
+                mtctr   r4
+                subi    r10,r3,4
+                mr      r0,r3
+                { assume not found }
+                li      r3,-1
+                ble     .LIndexDWordDone
+.LIndexDWordLoop:
+                lwzu    r9,4(r10)
+                cmplw   r9,r5
+                bdnzf   cr0*4+eq, .LIndexDWordLoop
+                { r3 still contains -1 here }
+                bne     .LIndexDWordDone
+                sub     r3,r10,r0
+                srawi   r3,r3,2
+.LIndexDWordDone:
+end;
+{$endif FPC_SYSTEM_HAS_INDEXDWORD}
+*)
+(*
+{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
+{$define FPC_SYSTEM_HAS_COMPAREBYTE}
+function CompareByte(const buf1,buf2;len:SizeInt):int64; assembler; nostackframe;
+{ input: r3 = buf1, r4 = buf2, r5 = len                           }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc         }
+asm
+        {  load the begin of the first buffer in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for buf1 since r3 contains result }
+        cmplwi  r5,0
+        mtctr   r5
+        subi    r11,r3,1
+        subi    r4,r4,1
+        li      r3,0
+        ble     .LCompByteDone
+.LCompByteLoop:
+        { load next chars }
+        lbzu    r9,1(r11)
+        lbzu    r10,1(r4)
+        { calculate difference }
+        sub.    r3,r9,r10
+        { if chars not equal or at the end, we're ready }
+        bdnzt   cr0*4+eq, .LCompByteLoop
+.LCompByteDone:
+end;
+{$endif FPC_SYSTEM_HAS_COMPAREBYTE}
+*)
+(*
+{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
+{$define FPC_SYSTEM_HAS_COMPAREWORD}
+function CompareWord(const buf1,buf2;len:SizeInt):int64; assembler; nostackframe;
+{ input: r3 = buf1, r4 = buf2, r5 = len                           }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc         }
+asm
+        {  load the begin of the first buffer in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for buf1 since r3 contains result }
+        cmplwi  r5,0
+        mtctr   r5
+        subi    r11,r3,2
+        subi    r4,r4,2
+        li      r3,0
+        ble     .LCompWordDone
+.LCompWordLoop:
+        { load next chars }
+        lhzu    r9,2(r11)
+        lhzu    r10,2(r4)
+        { calculate difference }
+        sub.    r3,r9,r10
+        { if chars not equal or at the end, we're ready }
+        bdnzt   cr0*4+eq, .LCompWordLoop
+.LCompWordDone:
+end;
+{$endif FPC_SYSTEM_HAS_COMPAREWORD}
+*)
+(*
+{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
+{$define FPC_SYSTEM_HAS_COMPAREDWORD}
+function CompareDWord(const buf1,buf2;len:SizeInt):int64; assembler; nostackframe;
+{ input: r3 = buf1, r4 = buf2, r5 = len                           }
+{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
+{ note: almost direct copy of strlcomp() from strings.inc         }
+asm
+        {  load the begin of the first buffer in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for buf1 since r3 contains result }
+        cmplwi  r5,0
+        mtctr   r5
+        subi    r11,r3,4
+        subi    r4,r4,4
+        li      r3,0
+        ble     .LCompDWordDone
+.LCompDWordLoop:
+        { load next chars }
+        lwzu    r9,4(r11)
+        lwzu    r10,4(r4)
+        { calculate difference }
+        sub.    r3,r9,r10
+        { if chars not equal or at the end, we're ready }
+        bdnzt   cr0*4+eq, .LCompDWordLoop
+.LCompDWordDone:
+end;
+{$endif FPC_SYSTEM_HAS_COMPAREDWORD}
+*)
+(*
+{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
+{$define FPC_SYSTEM_HAS_INDEXCHAR0}
+function IndexChar0(const buf;len:SizeInt;b:Char):int64; assembler; nostackframe;
+{ input: r3 = buf, r4 = len, r5 = b                         }
+{ output: r3 = position of found position (-1 if not found) }
+asm
+        {  load the begin of the buffer in the data cache }
+        dcbt    0,r3
+        { length = 0? }
+        cmplwi  r4,0
+        mtctr   r4
+        subi    r9,r3,1
+        subi    r0,r3,1
+        { assume not found }
+        li      r3,-1
+        { if yes, do nothing }
+        ble     .LIndexChar0Done
+.LIndexChar0Loop:
+        lbzu    r10,1(r9)
+        cmplwi  cr1,r10,0
+        cmplw   r10,r5
+        beq     cr1,.LIndexChar0Done
+        bdnzf   cr0*4+eq, .LIndexChar0Loop
+        bne     .LIndexChar0Done
+        sub     r3,r9,r0
+.LIndexChar0Done:
+end;
+{$endif FPC_SYSTEM_HAS_INDEXCHAR0}
+*)
+
+{****************************************************************************
+                                 String
+****************************************************************************}
+(*
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
+assembler; nostackframe;
+{ input: r3: pointer to result, r4: len, r5: sstr }
+asm
+        { load length source }
+        lbz     r10,0(r5)
+        {  load the begin of the dest buffer in the data cache }
+        dcbtst  0,r3
+
+        { put min(length(sstr),len) in r4 }
+        subfc   r7,r10,r4     { r0 := r4 - r10                               }
+        subfe   r4,r4,r4      { if r3 >= r4 then r3' := 0 else r3' := -1     }
+        and     r7,r7,r4      { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
+        add     r4,r10,r7     { if r3 >= r4 then r3' := r10 else r3' := r3   }
+
+        cmplwi  r4,0
+        { put length in ctr }
+        mtctr   r4
+        stb     r4,0(r3)
+        beq     .LShortStrCopyDone
+.LShortStrCopyLoop:
+        lbzu    r0,1(r5)
+        stbu    r0,1(r3)
+        bdnz    .LShortStrCopyLoop
+.LShortStrCopyDone:
+end;
+
+
+{$ifdef interncopy}
+procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
+{$else}
+procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
+{$endif}
+assembler; nostackframe;
+{ input: r3: len, r4: sstr, r5: dstr }
+asm
+        { load length source }
+        lbz     r10,0(r4)
+        {  load the begin of the dest buffer in the data cache }
+        dcbtst  0,r5
+
+        { put min(length(sstr),len) in r3 }
+        subc    r0,r3,r10    { r0 := r3 - r10                               }
+        subfe   r3,r3,r3     { if r3 >= r4 then r3' := 0 else r3' := -1     }
+        and     r3,r0,r3     { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
+        add     r3,r3,r10    { if r3 >= r4 then r3' := r10 else r3' := r3   }
+
+        cmplwi  r3,0
+        { put length in ctr }
+        mtctr   r3
+        stb     r3,0(r5)
+        beq     .LShortStrCopyDone2
+.LShortStrCopyLoop2:
+        lbzu    r0,1(r4)
+        stbu    r0,1(r5)
+        bdnz    .LShortStrCopyLoop2
+.LShortStrCopyDone2:
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
+*)
+(*
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+
+function fpc_shortstr_concat(const s1, s2: shortstring): shortstring; compilerproc; [public, alias: 'FPC_SHORTSTR_CONCAT'];
+{ expects that (r3) contains a pointer to the result r4 to s1, r5 to s2 }
+assembler;
+asm
+      { load length s1 }
+      lbz     r6, 0(r4)
+      { load length s2 }
+      lbz     r10, 0(r5)
+      { length 0 for s1? }
+      cmplwi  cr7,r6,0
+      { length 255 for s1? }
+      subfic. r7,r6,255
+      { length 0 for s2? }
+      cmplwi  cr1,r10,0
+      { calculate min(length(s2),255-length(s1)) }
+      subc    r8,r7,r10    { r8 := r7 - r10                                }
+      cror    4*6+2,4*1+2,4*7+2
+      subfe   r7,r7,r7     { if r7 >= r10 then r7' := 0 else r7' := -1     }
+      mtctr   r6
+      and     r7,r8,r7     { if r7 >= r10 then r7' := 0 else r7' := r7-r10 }
+      add     r7,r7,r10    { if r7 >= r10 then r7' := r10 else r7' := r7   }
+
+      mr      r9,r3
+
+      { calculate length of final string }
+      add     r8,r7,r6
+      stb     r8,0(r3)
+      beq     cr7, .Lcopys1loopDone
+    .Lcopys1loop:
+      lbzu    r0,1(r4)
+      stbu    r0,1(r9)
+      bdnz    .Lcopys1loop
+    .Lcopys1loopDone:
+      mtctr   r7
+      beq     cr6, .LconcatDone
+    .Lcopys2loop:
+      lbzu    r0,1(r5)
+      stbu    r0,1(r9)
+      bdnz    .Lcopys2loop
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
+*)
+(*
+{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+
+procedure fpc_shortstr_append_shortstr(var s1: shortstring; const s2: shortstring); compilerproc;
+{ expects that results (r3) contains a pointer to the current string s1, r4 }
+{ high(s1) and (r5) a pointer to the one that has to be concatenated        }
+assembler; nostackframe;
+asm
+      { load length s1 }
+      lbz     r6, 0(r3)
+      { load length s2 }
+      lbz     r10, 0(r5)
+      { length 0? }
+      cmplw   cr1,r6,r4
+      cmplwi  r10,0
+
+      { calculate min(length(s2),high(result)-length(result)) }
+      sub     r9,r4,r6
+      subc    r8,r9,r10    { r8 := r9 - r10                                }
+      cror    4*7+2,4*0+2,4*1+2
+      subfe   r9,r9,r9     { if r9 >= r10 then r9' := 0 else r9' := -1     }
+      and     r9,r8,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r10 }
+      add     r9,r9,r10    { if r9 >= r10 then r9' := r10 else r9' := r9   }
+
+      { calculate new length }
+      add     r10,r6,r9
+      { load value to copy in ctr }
+      mtctr   r9
+      { store new length }
+      stb     r10,0(r3)
+      { go to last current character of result }
+      add     r3,r6,r3
+
+      { if nothing to do, exit }
+      beq    cr7, .LShortStrAppendDone
+      { and concatenate }
+.LShortStrAppendLoop:
+      lbzu    r10,1(r5)
+      stbu    r10,1(r3)
+      bdnz    .LShortStrAppendLoop
+.LShortStrAppendDone:
+end;
+{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
+*)
+(*
+{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
+function fpc_shortstr_compare(const dstr,sstr:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
+assembler;
+asm
+      { load length sstr }
+      lbz     r9,0(r4)
+      { load length dstr }
+      lbz     r10,0(r3)
+      { save their difference for later and      }
+      { calculate min(length(sstr),length(dstr)) }
+      subfc    r7,r10,r9    { r0 := r9 - r10                               }
+      subfe    r9,r9,r9     { if r9 >= r10 then r9' := 0 else r9' := -1    }
+      and      r7,r7,r9     { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
+      add      r9,r10,r7    { if r9 >= r10 then r9' := r10 else r9' := r9  }
+
+      { first compare dwords (length/4) }
+      srwi.   r5,r9,2
+      { keep length mod 4 for the ends }
+      rlwinm  r9,r9,0,30,31
+      { already check whether length mod 4 = 0 }
+      cmplwi  cr1,r9,0
+      { so we can load r3 with 0, in case the strings both have length 0 }
+      mr      r8,r3
+      li      r3, 0
+      { length div 4 in ctr for loop }
+      mtctr   r5
+      { if length < 3, goto byte comparing }
+      beq     LShortStrCompare1
+      { setup for use of update forms of load/store with dwords }
+      subi    r4,r4,3
+      subi    r8,r8,3
+LShortStrCompare4Loop:
+      lwzu    r3,4(r4)
+      lwzu    r10,4(r8)
+      sub.    r3,r3,r10
+      bdnzt   cr0+eq,LShortStrCompare4Loop
+      { r3 contains result if we stopped because of "ne" flag }
+      bne     LShortStrCompareDone
+      { setup for use of update forms of load/store with bytes }
+      addi    r4,r4,3
+      addi    r8,r8,3
+LShortStrCompare1:
+      { if comparelen mod 4 = 0, skip this and return the difference in }
+      { lengths                                                         }
+      beq     cr1,LShortStrCompareLen
+      mtctr   r9
+LShortStrCompare1Loop:
+      lbzu    r3,1(r4)
+      lbzu    r10,1(r8)
+      sub.    r3,r3,r10
+      bdnzt   cr0+eq,LShortStrCompare1Loop
+      bne     LShortStrCompareDone
+LShortStrCompareLen:
+      { also return result in flags, maybe we can use this in the CG }
+      mr.     r3,r3
+LShortStrCompareDone:
+end;
+*)
+
+
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
+assembler; nostackframe;
+{$include strpas.inc}
+{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
+
+(*
+{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif} nostackframe;
+{$include strlen.inc}
+{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
+*)
+
+{$define FPC_SYSTEM_HAS_GET_FRAME}
+function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+  { all abi's I know use r1 as stack pointer }
+  mr r3, r1
+end;
+
+{NOTE: On MACOS, 68000 code might call powerpc code, through the MixedMode manager,
+(even in the OS in system 9). The pointer to the switching stack frame is
+indicated by the first bit set to 1. This is checked below.}
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
+function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+   cmpldi  r3,0
+   beq     .Lcaller_addr_frame_null
+   ld  r3,0(r3)
+
+   cmpldi  r3,0
+   beq     .Lcaller_addr_frame_null
+   ld r3,16(r3)
+.Lcaller_addr_frame_null:
+end;
+
+
+{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
+function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+    cmpldi  r3,0
+    beq     .Lcaller_frame_null
+    ld  r3,0(r3)
+.Lcaller_frame_null:
+end;
+
+{$define FPC_SYSTEM_HAS_ABS_LONGINT}
+function abs(l:longint):longint; assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_abs];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+        srawi   r0,r3,31
+        add     r3,r0,r3
+        xor     r3,r3,r0
+end;
+
+
+{****************************************************************************
+                                 Math
+****************************************************************************}
+
+{$define FPC_SYSTEM_HAS_ODD_LONGINT}
+function odd(l:longint):boolean;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+        rldicl r3, r3, 0, 63
+end;
+
+
+{$define FPC_SYSTEM_HAS_SQR_LONGINT}
+function sqr(l:longint):longint;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+        mullw   r3,r3,r3
+end;
+
+{$define FPC_SYSTEM_HAS_ODD_INT64}
+function odd(l:int64):boolean;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+        rldicl r3, r3, 0, 63
+end;
+
+
+{$define FPC_SYSTEM_HAS_SQR_INT64}
+function sqr(l:int64):int64;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+        mulld   r3,r3,r3
+end;
+
+
+{$define FPC_SYSTEM_HAS_SPTR}
+Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+asm
+        mr    r3,r1
+end;
+
+
+{****************************************************************************
+                                 Str()
+****************************************************************************}
+
+{ int_str: generic implementation is used for now }
+
+
+{****************************************************************************
+                             Multithreading
+****************************************************************************}
+
+{ do a thread save inc/dec }
+
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
+function declocked(var l : longint) : boolean;assembler;nostackframe;
+{ input:  address of l in r3                                      }
+{ output: boolean indicating whether l is zero after decrementing }
+asm
+.LDecLockedLoop:
+    lwarx    r10,0,r3
+    subi    r10,r10,1
+    stwcx.  r10,0,r3
+    bne-    .LDecLockedLoop
+    cntlzd  r3,r10
+    srdi    r3,r3,6
+end;
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
+procedure inclocked(var l : longint);assembler;nostackframe;
+asm
+.LIncLockedLoop:
+
+    lwarx   r10,0,r3
+    addi    r10,r10,1
+    stwcx.  r10,0,r3
+    bne-    .LIncLockedLoop
+end;
+
+
+{$define FPC_SYSTEM_HAS_DECLOCKED_INT64}
+function declocked(var l : int64) : boolean;assembler;nostackframe;
+{ input:  address of l in r3                                      }
+{ output: boolean indicating whether l is zero after decrementing }
+asm
+.LDecLockedLoop:
+    ldarx    r10,0,r3
+    subi    r10,r10,1
+    stdcx.  r10,0,r3
+    bne-    .LDecLockedLoop
+    cntlzd  r3,r10
+    srdi    r3,r3,6
+end;
+
+{$define FPC_SYSTEM_HAS_INCLOCKED_INT64}
+procedure inclocked(var l : int64);assembler;nostackframe;
+asm
+.LIncLockedLoop:
+
+    ldarx   r10,0,r3
+    addi    r10,r10,1
+    stdcx.  r10,0,r3
+    bne-    .LIncLockedLoop
+end;
+

+ 357 - 0
rtl/powerpc64/set.inc

@@ -0,0 +1,357 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe, member of the
+    Free Pascal development team
+
+    Include file with set operations called by the compiler
+
+    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.
+
+ **********************************************************************}
+
+{$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
+function fpc_set_load_small(l: fpc_small_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_LOAD_SMALL']; compilerproc;
+{
+  load a normal set p from a smallset l
+
+  on entry: p in r3, l in r4
+}
+asm
+        stw     r4,0(r3)
+        li      r0,0
+        stw     r0,4(r3)
+        std     r0,8(r3)
+        std     r0,16(r3)
+        std     r0,24(r3)
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
+{ checked 2001/09/28 (JM) }
+function fpc_set_create_element(b : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_CREATE_ELEMENT']; compilerproc;
+{
+  create a new set in p from an element b
+
+  on entry: pointer to result in r3, b in r4
+}
+asm
+        li      r0,0
+        stw     r0,0(r3)
+        stw     r0,4(r3)
+        stw     r0,8(r3)
+        stw     r0,12(r3)
+        stw     r0,16(r3)
+        stw     r0,20(r3)
+        stw     r0,24(r3)
+        stw     r0,28(r3)
+
+        // r0 := 1 shl r4[27-31] -> bit index in dword (rotate instructions
+        // with count in register only consider lower 5 bits of this register)
+        li      r0,1
+        rlwnm   r0,r0,r4,0,31
+
+        // get the index of the correct *dword* in the set
+        // (((b div 8) div 4)*4= (b div 8) and not(3))
+        // r5 := (r4 rotl(32-3)) and (0x01ffffff8)
+        rlwinm  r4,r4,31-3+1,3,31-2
+
+        // store the result
+        stwx    r0,r3,r4
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
+function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;assembler; compilerproc;
+{
+  add the element b to the set pointed by p
+
+  on entry: result in r3, source in r4, b in r5
+}
+asm
+       // copy source to result
+       lfd      f0,0(r4)
+       lfd      f1,8(r4)
+       lfd      f2,16(r4)
+       lfd      f3,24(r4)
+       stfd     f0,0(r3)
+       stfd     f1,8(r3)
+       stfd     f2,16(r3)
+       stfd     f3,24(r3)
+
+       // get the index of the correct *dword* in the set
+       // r0 := (r5 rotl(32-3)) and (0x0fffffff8)
+       rlwinm   r0,r5,31-3+1,3,31-2
+       // load dword in which the bit has to be set (and update r3 to this address)
+       lwzux    r4,r3,r0
+       li       r0,1
+       // generate bit which has to be inserted
+       // (can't use rlwimi, since that one only works for constants)
+       rlwnm    r5,r0,r5,0,31
+       // insert it
+       or       r5,r4,r5
+       // store result
+       stw      r5,0(r3)
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
+function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;assembler; compilerproc;
+{
+  suppresses the element b to the set pointed by p
+  used for exclude(set,element)
+
+  on entry: p in r3, b in r4
+}
+asm
+       // copy source to result
+       lfd      f0,0(r4)
+       lfd      f1,8(r4)
+       lfd      f2,16(r4)
+       lfd      f3,24(r4)
+       stfd     f0,0(r3)
+       stfd     f1,8(r3)
+       stfd     f2,16(r3)
+       stfd     f3,24(r3)
+       // get the index of the correct *dword* in the set
+       // r0 := (r4 rotl(32-3)) and (0x0fffffff8)
+       rlwinm   r0,r5,31-3+1,3,31-2
+       // load dword in which the bit has to be set (and update r3 to this address)
+       lwzux    r4,r3,r0
+       li       r0,1
+       // generate bit which has to be removed
+       rlwnm    r5,r0,r5,0,31
+       // remove it
+       andc     r5,r4,r5
+       // store result
+       stw      r4,0(r3)
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
+function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set;assembler; compilerproc;
+{
+  on entry: result in r3, l in r4, h in r5
+
+  on entry: result in r3, ptr to orgset in r4, l in r5, h in r6
+}
+asm
+  // copy source to result
+  lfd      f0,0(r4)
+  lfd      f1,8(r4)
+  lfd      f2,16(r4)
+  lfd      f3,24(r4)
+  stfd     f0,0(r3)
+  stfd     f1,8(r3)
+  stfd     f2,16(r3)
+  stfd     f3,24(r3)
+
+  cmplw  cr0,r5,r6
+  bgt    cr0,.Lset_range_exit
+  rlwinm r4,r5,31-3+1,3,31-2  // divide by 8 to get starting and ending byte-
+  { load the set the data cache }
+  dcbtst r3,r4
+  rlwinm r9,r6,31-3+1,3,31-2  // address and clear two lowest bits to get
+                              //  start/end longint address
+  sub.   r9,r9,r4             // are bit lo and hi in the same longint?
+  rlwinm r6,r6,0,31-5+1,31    // hi := hi mod 32 (= "hi and 31", but the andi
+                              //  instr. only exists in flags modifying form)
+  rlwinm r5,r5,0,31-5+1,31    // lo := lo mod 32 (= "lo and 31", but the andi
+                              //  instr. only exists in flags modifying form)
+  li     r10,-1               // r10 = $0x0ffffffff = bitmask to be inserted
+  subfic r6,r6,31             // hi := 31 - (hi mod 32) = shift count for later
+  slw    r10,r10,r5           // shift bitmask to clear bits below lo
+  lwzux  r5,r3,r4             // go to starting pos in set and load value
+                              //  (lo is not necessary anymore)
+  beq    .Lset_range_hi       // if bit lo and hi in same longint, keep
+                              //  current mask and adjust for hi bit
+  subic. r9,r9,4              // bit hi in next longint?
+  or     r5,r5,r10            // merge and
+  stw    r5,0(r3)             // store current mask
+  li     r10,-1               // new mask
+  lwzu   r5,4(r3)             // load next longint of set
+  beq    .Lset_range_hi       // bit hi in this longint -> go to adjust for hi
+  subi   r3,r3,4
+.Lset_range_loop:
+  subic. r9,r9,4
+  stwu   r10,4(r3)            // fill longints in between with full mask
+  bne    .Lset_range_loop
+  lwzu   r5,4(r3)             // load next value from set
+.Lset_range_hi:               // in all cases, r3 here contains the address of
+                              //  the longint which contains the hi bit and r4
+                              //  contains this longint
+  srw    r9,r10,r6            // r9 := bitmask shl (31 - (hi mod 32)) =
+                              //  bitmask with bits higher than hi cleared
+                              //  (r8 = $0xffffffff unless the first beq was
+                              //   taken)
+  and    r10,r9,r10           // combine lo and hi bitmasks for this longint
+  or     r5,r5,r10            // and combine with existing set
+  stw    r5,0(r3)             // store to set
+.Lset_range_exit:
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
+function fpc_set_in_byte(const p: fpc_normal_set; b : byte): boolean;compilerproc;assembler;[public,alias:'FPC_SET_IN_BYTE'];
+{
+  tests if the element b is in the set p, the **zero** flag is cleared if it's present
+
+  on entry: p in r3, b in r4
+}
+asm
+       // get the index of the correct *dword* in the set
+       // r0 := (r4 rotl(32-3)) and (0x0fffffff8)
+       rlwinm   r0,r4,31-3+1,3,31-2
+
+       // load dword in which the bit has to be tested
+       lwzx     r3,r3,r0
+
+       // r4 := 32 - r4 (no problem if r4 > 32, the rlwnm next does a mod 32)
+       subfic   r4,r4,32
+       // r3 := (r3 shr (r4 mod 32)) and 1
+       rlwnm    r3,r3,r4,31,31
+end;
+
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
+function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
+{
+  adds set1 and set2 into set dest
+  on entry: result in r3, set1 in r4, set2 in r5
+}
+asm
+       {  load the begin of the result set in the data cache }
+       dcbtst   0,r3
+       li       r0,8
+       mtctr    r0
+       subi     r5,r5,4
+       subi     r4,r4,4
+       subi     r3,r3,4
+   .LMADDSETS1:
+      lwzu      r0,4(r4)
+      lwzu      r10,4(r5)
+      or        r0,r0,r10
+      stwu      r0,4(r3)
+      bdnz      .LMADDSETS1
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
+function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_MUL_SETS']; compilerproc;
+{
+  multiplies (takes common elements of) set1 and set2 result put in dest
+  on entry: result in r3, set1 in r4, set2 in r5
+}
+asm
+       {  load the begin of the result set in the data cache }
+       dcbtst   0,r3
+       li       r0,8
+       mtctr    r0
+       subi     r5,r5,4
+       subi     r4,r4,4
+       subi     r3,r3,4
+   .LMMULSETS1:
+      lwzu      r0,4(r4)
+      lwzu      r10,4(r5)
+      and       r0,r0,r10
+      stwu      r0,4(r3)
+      bdnz      .LMMULSETS1
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SUB_SETS}
+function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_SUB_SETS']; compilerproc;
+{
+  computes the diff from set1 to set2 result in dest
+  on entry: result in r3, set1 in r4, set2 in r5
+}
+asm
+       {  load the begin of the result set in the data cache }
+       dcbtst   0,r3
+       li       r0,8
+       mtctr    r0
+       subi     r5,r5,4
+       subi     r4,r4,4
+       subi     r3,r3,4
+   .LMSUBSETS1:
+      lwzu      r0,4(r4)
+      lwzu      r10,4(r5)
+      andc      r0,r0,r10
+      stwu      r0,4(r3)
+      bdnz      .LMSUBSETS1
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS}
+function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_SYMDIF_SETS']; compilerproc;
+{
+   computes the symetric diff from set1 to set2 result in dest
+  on entry: result in r3, set1 in r4, set2 in r5
+}
+asm
+       {  load the begin of the result set in the data cache }
+       dcbtst   0,r3
+       li       r0,8
+       mtctr    r0
+       subi     r5,r5,4
+       subi     r4,r4,4
+       subi     r3,r3,4
+   .LMSYMDIFSETS1:
+      lwzu      r0,4(r4)
+      lwzu      r10,4(r5)
+      xor       r0,r0,r10
+      stwu      r0,4(r3)
+      bdnz      .LMSYMDIFSETS1
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_COMP_SETS}
+function fpc_set_comp_sets(const set1,set2: fpc_normal_set): boolean;assembler;[public,alias:'FPC_SET_COMP_SETS']; compilerproc;
+{
+  compares set1 and set2 zeroflag is set if they are equal
+  on entry: set1 in r3, set2 in r4
+}
+asm
+       li       r0,8
+       mtctr    r0
+       subi     r3,r3,4
+       subi     r4,r4,4
+    .LMCOMPSETS1:
+       lwzu     r0,4(r3)
+       lwzu     r10,4(r4)
+       sub.     r0,r0,r10
+       bdnzt    cr0*4+eq,.LMCOMPSETS1
+       cntlzw   r3,r0
+       srwi.    r3,r3,5
+end;
+
+
+{$define FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET}
+function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean;assembler;[public,alias:'FPC_SET_CONTAINS_SETS']; compilerproc;
+{
+  on exit, zero flag is set if set1 <= set2 (set2 contains set1)
+  on entry: set1 in r3, set2 in r4
+}
+asm
+       li       r0,8
+       mtctr    r0
+       subi     r3,r3,4
+       subi     r4,r4,4
+    .LMCONTAINSSETS1:
+       lwzu     r0,4(r3)
+       lwzu     r10,4(r4)
+       { set1 and not(set2) = 0? }
+       andc.    r0,r0,r10
+       bdnzt    cr0*4+eq,.LMCONTAINSSETS1
+       cntlzw   r3,r0
+       srwi.    r3,r3,5
+end;
+
+
+
+

+ 125 - 0
rtl/powerpc64/setjump.inc

@@ -0,0 +1,125 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2002 by Jonas Maebe and other members of the
+    Free Pascal development team
+
+    SetJmp and LongJmp implementation for exception handling
+
+    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.
+
+ **********************************************************************}
+{
+   jmp_buf = packed record
+      r1, r2, lr,r14,r15,
+     r16,r17,r18,r19,r20,
+     r21,r22,r23,r24,r25,
+     r26,r27,r28,r29,r30,
+     r31,cr : int64;
+     // 176
+     f14,f15,f16,
+     // 200
+     f17,f18,f19,f20,f21,
+     f22,f23,f24,f25,f26,
+     f27,f28,f29,f30,f31 : double;
+   end;
+   pjmp_buf = ^jmp_buf;}
+
+function setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; nostackframe;
+  asm
+     std     r1,0(r3)    // store r1
+     mflr    r0
+     std     r2,8(r3)    // store r2
+     std     r14,24(r3)  // store r14
+     stfd    f14,176(r3) // store f14
+     std     r0,16(r3)   // store lr
+     std     r15,32(r3)  // store r15
+     stfd    f15,184(r3) // store f15
+     mfcr    r0
+     std     r16,40(r3)  // store r16
+     stfd    f16,192(r3) // store f16
+     std     r0,168(r3)  // store cr
+     std     r17,48(r3)  // store r17
+     stfd    f17,200(r3) // store f17
+     std     r18,56(r3)  // ...
+     stfd    f18,208(r3)
+     std     r19,64(r3)
+     stfd    f19,216(r3)
+     std     r20,72(r3)
+     stfd    f20,224(r3)
+     std     r21,80(r3)
+     stfd    f21,232(r3)
+     std     r22,88(r3)
+     stfd    f22,240(r3)
+     std     r23,96(r3)
+     stfd    f23,248(r3)
+     std     r24,104(r3)
+     stfd    f24,256(r3)
+     std     r25,112(r3)
+     stfd    f25,264(r3)
+     std     r26,120(r3)
+     stfd    f26,272(r3)
+     std     r27,128(r3)
+     stfd    f27,280(r3)
+     std     r28,136(r3)
+     stfd    f28,288(r3)
+     std     r29,144(r3)
+     stfd    f29,296(r3)
+     std     r30,152(r3)
+     stfd    f30,304(r3)
+     std     r31,160(r3)
+     stfd    f31,312(r3)
+     li      r3,0
+  end;
+
+procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP']; nostackframe;
+  asm
+     ld      r1,0(r3)    // load r1
+     ld      r2,8(r3)    // load r2
+     ld      r0,16(r3)   // load lr
+     ld      r14,24(r3)  // load r14
+     lfd     f14,176(r3)
+     ld      r15,32(r3)  // load r15
+     lfd     f15,184(r3)
+     ld      r16,40(r3)
+     lfd     f16,192(r3)
+     ld      r17,48(r3)
+     lfd     f17,200(r3)
+     ld      r18,56(r3)
+     lfd     f18,208(r3)
+     ld      r19,64(r3)
+     lfd     f19,216(r3)
+     ld      r20,72(r3)
+     lfd     f20,224(r3)
+     mtlr    r0
+     ld      r21,80(r3)
+     lfd     f21,232(r3)
+     ld      r22,88(r3)
+     lfd     f22,240(r3)
+     ld      r0,168(r3)
+     ld      r23,96(r3)
+     lfd     f23,248(r3)
+     ld      r24,104(r3)
+     lfd     f24,256(r3)
+     ld      r25,112(r3)
+     lfd     f25,264(r3)
+     mtcrf   0xff,r0
+     ld      r26,120(r3)
+     lfd     f26,272(r3)
+     ld      r27,128(r3)
+     lfd     f27,280(r3)
+     ld      r28,136(r3)
+     lfd     f28,288(r3)
+     ld      r29,144(r3)
+     lfd     f29,296(r3)
+     ld      r30,152(r3)
+     lfd     f30,304(r3)
+     ld      r31,160(r3)
+     lfd     f31,312(r3)
+     mr r3,r4
+    end;
+

+ 26 - 0
rtl/powerpc64/setjumph.inc

@@ -0,0 +1,26 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000-2002 by Jonas Maebe and other members of the
+    Free Pascal development team
+
+    SetJmp/Longjmp declarations
+
+    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.
+
+ **********************************************************************}
+
+type
+   jmp_buf = packed record
+     r1,r2,lr,r14,r15,r16,r17,r18,r19,r20,r21,r22,r23,r24,r25,r26,r27,r28,r29,r30,r31,cr : int64;
+     f14,f15,f16,f17,f18,f19,f20,f21,f22,f23,f24,f25,f26,f27,f28,f29,f30,f31 : double;
+   end;
+   pjmp_buf = ^jmp_buf;
+
+function setjmp(var S : jmp_buf) : longint;
+procedure longjmp(var S : jmp_buf;value : longint);
+

+ 503 - 0
rtl/powerpc64/strings.inc

@@ -0,0 +1,503 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000 by Jonas Maebe, member of the
+    Free Pascal development team
+
+    Processor dependent part of strings.pp, that can be shared with
+    sysutils unit.
+
+    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.
+
+ **********************************************************************}
+
+{ Note: the implementation of these routines is for BIG ENDIAN only!! (JM) }
+
+{$ifndef FPC_UNIT_HAS_STRCOPY}
+{$define FPC_UNIT_HAS_STRCOPY}
+function strcopy(dest,source : pchar) : pchar;assembler;
+{ in: dest in r3, source in r4 }
+{ out: result (dest) in r3     }
+asm
+{  in: dest in r3, source in r4  }
+{  out: result (dest) in r3      }
+        {  load the begin of the source string in the data cache }
+        dcbt    0,r4
+        {  get # of misaligned bytes  }
+        rlwinm. r10,r4,0,31-2+1,31
+        subfic  r10,r10,4
+        mtctr   r10
+        {  since we have to return dest intact, use another register for  }
+        {  dest in the copy loop                                          }
+        subi    r9,r3,1
+        subi    r4,r4,1
+        beq     .LStrCopyAligned
+.LStrCopyAlignLoop:
+        {  load next byte  }
+        lbzu    r0,1(r4)
+        {  end of string?  }
+        cmplwi  cr0,r0,0
+        {  store byte  }
+        stbu    r0,1(r9)
+        {  loop if misaligned bytes left and not end of string found }
+        bdnzf   cr0*4+eq,.LStrCopyAlignLoop
+        beq     .LStrCopyDone
+.LStrCopyAligned:
+        subi    r4,r4,3
+        subi    r9,r9,3
+        { setup magic constants }
+        {$ifdef macos}
+        {  load constant 0xfefefeff }
+        lis     r8,0xfefe
+        addi    r8,r8,0xfeff
+        {  load constant 0x80808080}
+        lis     r7,0x8080
+        addi    r7,r7,0x8080
+        {$else}
+        lis     r8,(0xfefefeff)@ha
+        addi    r8,r8,(0xfefefeff)@l
+        lis     r7,(0x80808080)@ha
+        addi    r7,r7,(0x80808080)@l
+        {$endif}
+        { load first 4 bytes  }
+        lwzu    r0,4(r4)
+
+.LStrCopyAlignedLoop:
+        { test for zero byte }
+        add     r10,r0,r8
+        andc    r10,r10,r0
+        and.    r10,r10,r7
+        bne     .LStrCopyEndFound
+        stwu    r0,4(r9)
+        { load next 4 bytes (do it here so the load can begin while the }
+        { the branch is processed)                                      }
+        lwzu    r0,4(r4)
+        b       .LStrCopyAlignedLoop
+.LStrCopyEndFound:
+        { adjust for possible $01 bytes coming before the terminating 0 byte }
+        rlwinm  r8,r0,7,0,31
+        andc    r10,r10,r8
+        { result is either 0, 8, 16 or 24 depending on which byte is zero }
+        cntlzw  r10,r10
+        addi    r9,r9,3
+.LStrCopyWrapUpLoop:
+        subic.  r10,r10,8
+        rlwinm  r0,r0,8,0,31
+        stbu    r0,1(r9)
+        bge     .LStrCopyWrapUpLoop
+.LStrCopyDone:
+        {  r3 still contains dest here  }
+end;
+{$endif FPC_UNIT_HAS_STRCOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STRECOPY}
+{$define FPC_UNIT_HAS_STRECOPY}
+function strecopy(dest,source : pchar) : pchar;assembler;
+{ in: dest in r3, source in r4        }
+{ out: result (end of new dest) in r3 }
+asm
+        {  load the begin of the source string in the data cache }
+        dcbt    0,r4
+        {  get # of misaligned bytes  }
+        rlwinm. r10,r4,0,31-2+1,31
+        subfic  r10,r10,4
+        mtctr   r10
+        subi    r3,r3,1
+        subi    r4,r4,1
+        beq     .LStrECopyAligned
+.LStrECopyAlignLoop:
+        {  load next byte  }
+        lbzu    r0,1(r4)
+        {  end of string?  }
+        cmplwi  cr0,r0,0
+        {  store byte  }
+        stbu    r0,1(r3)
+        {  loop if misaligned bytes left and not end of string found }
+        bdnzf   cr0*4+eq,.LStrECopyAlignLoop
+        beq     .LStrECopyDone
+.LStrECopyAligned:
+        subi    r4,r4,3
+        subi    r3,r3,3
+        { setup magic constants }
+        {$ifdef macos}
+        {  load constant 0xfefefeff }
+        lis     r8,0xfefe
+        addi    r8,r8,0xfeff
+        {  load constant 0x80808080}
+        lis     r7,0x8080
+        addi    r7,r7,0x8080
+        {$else}
+        lis     r8,(0xfefefeff)@ha
+        addi    r8,r8,(0xfefefeff)@l
+        lis     r7,(0x80808080)@ha
+        addi    r7,r7,(0x80808080)@l
+        {$endif}
+{
+        li      r8,-257        { 0x0feff }
+        andis.  r8,r8,0x0fefe
+        li      r9,-32640      { 0x08080 }
+        andis.  r9,r9,0x08080
+}
+.LStrECopyAlignedLoop:
+
+        {  load next 4 bytes  }
+        lwzu    r0,4(r4)
+
+        { test for zero byte }
+        add     r10,r0,r8
+        andc    r10,r10,r0
+        and.    r10,r10,r7
+        bne     .LStrECopyEndFound
+        stwu    r0,4(r3)
+        b       .LStrECopyAlignedLoop
+.LStrECopyEndFound:
+        { adjust for possible $01 bytes coming before the terminating 0 byte }
+        rlwinm  r8,r0,7,0,31
+        andc    r10,r10,r8
+        { result is either 0, 8, 16 or 24 depending on which byte is zero }
+        cntlzw  r10,r10
+        addi    r3,r3,3
+.LStrECopyWrapUpLoop:
+        subic.  r10,r10,8
+        rlwinm  r0,r0,8,0,31
+        stbu    r0,1(r3)
+        bge     .LStrECopyWrapUpLoop
+.LStrECopyDone:
+        {  r3 contains new dest here  }
+end;
+{$endif FPC_UNIT_HAS_STRECOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STRLCOPY}
+{$define FPC_UNIT_HAS_STRLCOPY}
+function strlcopy(dest,source : pchar;maxlen : int64) : pchar;assembler;
+{ in: dest in r3, source in r4, maxlen in r5 }
+{ out: result (dest) in r3                   }
+asm
+        {  load the begin of the source string in the data cache }
+        dcbt    0,r4
+        mtctr   r5
+        subi    r4,r4,1
+        subi    r10,r3,1
+.LStrlCopyLoop:
+        lbzu    r0,1(r4)
+        cmplwi  r0,0
+        stbu    r0,1(r10)
+        bdnzf   cr0*4+eq, .LStrlCopyLoop
+        { if we stopped because we copied a #0, we're done }
+        beq     .LStrlCopyDone
+        { otherwise add the #0 }
+        li      r0,0
+        stb     r0,1(r10)
+.LStrlCopyDone:
+end;
+{$endif FPC_UNIT_HAS_STRLCOPY}
+
+
+{$ifndef FPC_UNIT_HAS_STREND}
+{$define FPC_UNIT_HAS_STREND}
+function strend(p : pchar) : pchar;assembler;
+{ in: p in r3                  }
+{ out: result (end of p) in r3 }
+asm
+        {  load the begin of the string in the data cache }
+        dcbt    0,r3
+        { empty/invalid string? }
+        cmplwi  r3,0
+        { if yes, do nothing }
+        beq     .LStrEndDone
+        subi    r3,r3,1
+.LStrEndLoop:
+        lbzu    r0,1(r3)
+        cmplwi  r0,0
+        bne     .LStrEndLoop
+.LStrEndDone:
+end;
+{$endif FPC_UNIT_HAS_STREND}
+
+
+{$ifndef FPC_UNIT_HAS_STRCOMP}
+{$define FPC_UNIT_HAS_STRCOMP}
+function strcomp(str1,str2 : pchar) : int64;assembler;
+{ in: str1 in r3, str2 in r4                                                }
+{ out: result (= 0 if strings equal, < 0 if str1 < str2, > 0 if str1 > str2 }
+{      in r3                                                                }
+asm
+        { use r0 instead of r3 for str1 since r3 contains result }
+        subi    r9,r3,1
+        subi    r4,r4,1
+.LStrCompLoop:
+        { load next chars }
+        lbzu    r0,1(r9)
+        { check if one is zero }
+        cmplwi  cr1,r0,0
+        lbzu    r10,1(r4)
+        { calculate difference }
+        sub.    r3,r0,r10
+        { if chars not equal, we're ready }
+        bne     .LStrCompDone
+        { if they are equal and one is zero, then the other one is zero too }
+        { and we're done as well (r3 also contains 0 then)                  }
+        { otherwise loop                                                    }
+        bne     cr1,.LStrCompLoop
+.LStrCompDone:
+end;
+{$endif FPC_UNIT_HAS_STRCOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRLCOMP}
+{$define FPC_UNIT_HAS_STRLCOMP}
+function strlcomp(str1,str2 : pchar;l : int64) : int64;assembler;
+{ (same as strcomp, but maximally compare until l'th character)             }
+{ in: str1 in r3, str2 in r4, l in r5                                       }
+{ out: result (= 0 if strings equal, < 0 if str1 < str2, > 0 if str1 > str2 }
+{      in r3                                                                }
+asm
+        { load the begin of one of the strings in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for str1 since r3 contains result }
+        cmplwi  r5,0
+        subi    r9,r3,1
+        li      r3,0
+        beq     .LStrlCompDone
+        mtctr   r5
+        subi    r4,r4,1
+.LStrlCompLoop:
+        { load next chars }
+        lbzu    r0,1(r9)
+        { check if one is zero }
+        cmplwi  cr1,r0,0
+        lbzu    r10,1(r4)
+        { calculate difference }
+        sub.    r3,r0,r10
+        { if chars not equal, we're ready }
+        bne     .LStrlCompDone
+        { if they are equal and one is zero, then the other one is zero too }
+        { and we're done as well (r3 also contains 0 then)                  }
+        { otherwise loop (if ctr <> 0)                                      }
+        bdnzf  cr1*4+eq,.LStrlCompLoop
+.LStrlCompDone:
+end;
+{$endif FPC_UNIT_HAS_STRLCOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRICOMP}
+{$define FPC_UNIT_HAS_STRICOMP}
+function stricomp(str1,str2 : pchar) : int64;assembler;
+{ in: str1 in r3, str2 in r4                                 }
+{ out: result of case insensitive comparison (< 0, = 0, > 0) }
+asm
+        { use r5 instead of r3 for str1 since r3 contains result }
+        subi    r5,r3,1
+        subi    r4,r4,1
+.LStriCompLoop:
+        { load next chars }
+        lbzu    r6,1(r5)
+        { check if one is zero }
+        cmplwi  cr1,r6,0
+        lbzu    r7,1(r4)
+        { calculate difference }
+        sub.    r3,r6,r7
+        { if chars are equal, no further test is necessary }
+        beq+    .LStriCompEqual
+
+        { make both lowercase, no branches }
+
+        { r3 := pred('A') - r6 }
+        subfic    r3,r6,64
+        { if r6 < 'A' then r8 := 0 else r8 := $ffffffff }
+        subfe    r8,r8,r8
+        { same for r7 }
+        subfic   r3,r7,64
+        subfe    r9,r9,r9
+
+        { r3 := r6 - succ('Z') }
+        subic    r3,r6,91
+        { if r6 < 'A' then r8 := 0 else r8 := $20 }
+        andi.    r8,r8,0x020
+        { if r6 > Z then r10 := 0 else r10 := $ffffffff }
+        subfe    r10,r10,r10
+        { same for r7 }
+        subic    r3,r7,91
+        andi.    r9,r9,0x020
+        subfe    r11,r11,r11
+
+        { if (r6 in ['A'..'Z'] then r8 := $20 else r8 := 0 }
+        and      r8,r8,r10
+        { same for r7 }
+        and      r9,r9,r11
+
+        { make lowercase }
+        add      r6,r6,r8
+        { same for r7 }
+        add      r7,r7,r9
+
+        { compare again }
+        sub.     r3,r6,r7
+        bne-      .LStriCompDone
+.LStriCompEqual:
+        { if they are equal and one is zero, then the other one is zero too }
+        { and we're done as well (r3 also contains 0 then)                  }
+        { otherwise loop                                                    }
+        bne     cr1,.LStriCompLoop
+.LStriCompDone:
+end;
+{$endif FPC_UNIT_HAS_STRICOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRLICOMP}
+{$define FPC_UNIT_HAS_STRLICOMP}
+function strlicomp(str1,str2 : pchar;l : int64) : int64;assembler;
+{ (same as stricomp, but maximally compare until l'th character) }
+{ in: str1 in r3, str2 in r4, l in r5                            }
+{ out: result of case insensitive comparison (< 0, = 0, > 0)     }
+asm
+        {  load the begin of one of the string in the data cache }
+        dcbt    0,r3
+        { use r0 instead of r3 for str1 since r3 contains result }
+        cmplwi  r5,0
+        subi    r9,r3,1
+        li      r3,0
+        beq-    .LStrliCompDone
+        mtctr   r5
+        subi    r4,r4,1
+.LStrliCompLoop:
+        { load next chars }
+        lbzu    r0,1(r9)
+        { check if one is zero }
+        cmplwi  cr1,r0,0
+        lbzu    r10,1(r4)
+        { calculate difference }
+        sub.    r3,r0,r10
+        { if chars are equal, no further test is necessary }
+        beq     .LStrliCompEqual
+
+        { see stricomp for explanation }
+
+        subfic   r3,r0,64
+        subfe    r8,r8,r8
+        subfic   r3,r10,64
+        subfe    r5,r5,r5
+
+        subic    r3,r0,91
+        andi.    r8,r8,0x020
+        subfe    r7,r7,r7
+        subic    r3,r10,91
+        andi.    r5,r5,0x020
+        subfe    r11,r11,r11
+
+        and      r8,r8,r7
+        and      r5,r5,r11
+        add      r0,r0,r8
+        add      r10,r10,r5
+
+        { compare again }
+        sub.     r3,r0,r10
+        bne      .LStrliCompDone
+.LStrliCompEqual:
+        { if they are equal and one is zero, then the other one is zero too }
+        { and we're done as well (r3 also contains 0 then)                  }
+        { otherwise loop (if ctr <> 0)                                      }
+        bdnzf    cr1*4+eq,.LStrliCompLoop
+.LStrliCompDone:
+end;
+{$endif FPC_UNIT_HAS_STRLICOMP}
+
+
+{$ifndef FPC_UNIT_HAS_STRSCAN}
+{$define FPC_UNIT_HAS_STRSCAN}
+function strscan(p : pchar;c : char) : pchar;assembler;
+asm
+        { empty/invalid string? }
+        cmplwi  r3,0
+        { if yes, do nothing }
+        beq     .LStrScanDone
+        subi    r3,r3,1
+.LStrScanLoop:
+        lbzu    r0,1(r3)
+        cmplw   cr1,r0,r4
+        cmplwi  r0,0
+        beq     cr1,.LStrScanDone
+        bne     .LStrScanLoop
+        li      r3, 0
+.LStrScanDone:
+end;
+{$endif FPC_UNIT_HAS_STRSCAN}
+
+
+{$ifndef FPC_UNIT_HAS_STRRSCAN}
+{$define FPC_UNIT_HAS_STRRSCAN}
+function strrscan(p : pchar;c : char) : pchar;assembler;
+asm
+        { empty/invalid string? }
+        cmplwi  r3,0
+        { if yes, do nothing }
+        beq     .LStrrScanDone
+        { make r5 will be walking through the string }
+        subi    r5,r3,1
+        { assume not found }
+        li      r3,0
+.LStrrScanLoop:
+        lbzu    r10,1(r5)
+        cmplw   cr1,r10,r4
+        cmplwi  cr0,r10,0
+        bne+    cr1,.LStrrScanNotFound
+        { store address of found position }
+        mr      r3,r5
+.LStrrScanNotFound:
+        bne     .LStrrScanLoop
+.LStrrScanDone:
+end;
+{$endif FPC_UNIT_HAS_STRRSCAN}
+
+
+{$ifndef FPC_UNIT_HAS_STRUPPER}
+{$define FPC_UNIT_HAS_STRUPPER}
+function strupper(p : pchar) : pchar;assembler;
+asm
+        cmplwi  r3,0
+        beq     .LStrUpperNil
+        subi    r9,r3,1
+.LStrUpperLoop:
+        lbzu    r10,1(r9)
+        { a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) }
+        subi    r0,r10,97
+        cmplwi  r0,122-97
+        cmplwi  cr1,r10,0
+        subi    r10,r10,0x20
+        bgt     .LStrUpper1
+        stb     r10,0(r9)
+.LStrUpper1:
+        bne     cr1,.LStrUpperLoop
+.LStrUpperNil:
+end;
+{$endif FPC_UNIT_HAS_STRUPPER}
+
+
+{$ifndef FPC_UNIT_HAS_STRLOWER}
+{$define FPC_UNIT_HAS_STRLOWER}
+function strlower(p : pchar) : pchar;assembler;
+asm
+        cmplwi  r3,0
+        beq     .LStrLowerNil
+        subi    r9,r3,1
+.LStrLowerLoop:
+        lbzu    r10,1(r9)
+        { a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) }
+        subi    r0,r10,65
+        cmplwi  r0,90-65
+        cmplwi  cr1,r10,0
+        addi    r10,r10,0x20
+        bgt     .LStrLower1
+        stb     r10,0(r9)
+.LStrLower1:
+        bne     cr1,.LStrLowerLoop
+.LStrLowerNil:
+end;
+{$endif FPC_UNIT_HAS_STRLOWER}
+

+ 40 - 0
rtl/powerpc64/stringss.inc

@@ -0,0 +1,40 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe, member of the
+    Free Pascal development team
+
+    Processor dependent part of strings.pp, not shared with
+    sysutils unit.
+
+    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.
+
+ **********************************************************************}
+
+{$ifndef FPC_UNIT_HAS_STRPCOPY}
+{$define FPC_UNIT_HAS_STRPCOPY}
+function strpcopy(d : pchar;const s : string) : pchar;assembler;
+asm
+        { get length  }
+        lbz     r0,0(r4)
+        { put in counter }
+        cmpldi  r0,0
+        mtctr   r0
+        subi    r10,r3,1
+        beq     .LStrPCopyEmpty
+.LStrPCopyLoop:
+        { copy everything }
+        lbzu    r0,1(r4)
+        stbu    r0,1(r10)
+        bdnz    .LStrPCopyLoop
+        { add terminating #0 }
+        li      r0,0
+.LStrPCopyEmpty:
+        stb     r0,1(r10)
+end;
+{$endif FPC_UNIT_HAS_STRPCOPY}
+

+ 33 - 0
rtl/powerpc64/strlen.inc

@@ -0,0 +1,33 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Processor specific implementation of strlen
+
+    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.
+
+ **********************************************************************}
+
+{ in: p in r3                }
+{ out: result (length) in r3 }
+asm
+        {  load the begin of the string in the data cache }
+        dcbt    0,r3
+        { empty/invalid string? }
+        cmpldi  cr0,r3,0
+        { if yes, do nothing }
+        beq     .LStrLenDone
+        subi    r9,r3,1
+.LStrLenLoop:
+        lbzu    r10,1(r9)
+        cmpldi  cr0,r10,0
+        bne     .LStrLenLoop
+        sub     r3,r9,r3
+.LStrLenDone:
+end;
+

+ 54 - 0
rtl/powerpc64/strpas.inc

@@ -0,0 +1,54 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Processor specific implementation of strpas
+
+    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.
+
+ **********************************************************************}
+{
+   r3: result address
+   r4: src
+}
+asm
+        { nil? }
+        cmpldi   r4, 0
+        {  load the begin of the string in the data cache }
+        dcbt    0,r4
+        { maxlength }
+        li      r10,255
+        mtctr   r10
+        { at LStrPasDone, we set the length of the result to 255 - r10 - r4 }
+        { = 255 - 255 - 0 if the soure = nil -> perfect :)                  }
+        beq     .LStrPasDone
+        { save address for at the end  and use r5 in loop }
+        mr      r5,r3
+        { no "subi r5,r5,1" because the first byte = length byte }
+        subi    r4,r4,1
+.LStrPasLoop:
+        lbzu    r10,1(r4)
+        cmpldi  cr0,r10,0
+        stbu    r10,1(r5)
+        bdnzf   cr0*4+eq, .LStrPasLoop
+
+        { if we stopped because of a terminating #0, decrease the length by 1 }
+        cntlzd  r4,r10
+        { get remaining count for length }
+        mfctr   r10
+        { if r10 was zero (-> stopped because of zero byte), then r4 will be 64 }
+        { (64 leading zero bits) -> shr 6 = 1, otherwise this will be zero      }
+        srdi    r4,r4,6
+.LStrPasDone:
+        subfic  r10,r10,255
+        sub     r10,r10,r4
+
+        { store length }
+        stb     r10,0(r3)
+end;
+

+ 73 - 0
rtl/powerpc64/sysutilp.inc

@@ -0,0 +1,73 @@
+{
+    This file is part of the Free Pascal run time library.
+
+    Copyright (c) 2001 by Jonas Maebe,
+    member of the Free Pascal development team
+
+    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.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+  This include contains cpu-specific routines
+  ---------------------------------------------------------------------}
+
+function InterLockedDecrement (var Target: longint) : longint; assembler;
+{ input:  address of target in r3 }
+{ output: target-1 in r3          }
+{ side-effect: target := target-1 }
+asm
+.LInterLockedDecLoop:
+        lwarx   r10,0,r3
+        subi    r10,r10,1
+        stwcx.  r10,0,r3
+        bne     .LInterLockedDecLoop
+        mr      r3,r10
+end;
+
+
+function InterLockedIncrement (var Target: longint) : longint; assembler;
+{ input:  address of target in r3 }
+{ output: target+1 in r3          }
+{ side-effect: target := target+1 }
+asm
+.LInterLockedIncLoop:
+        lwarx   r10,0,r3
+        addi    r10,r10,1
+        stwcx.  r10,0,r3
+        bne     .LInterLockedIncLoop
+        mr      r3,r10
+end;
+
+
+function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
+{ input:  address of target in r3, source in r4 }
+{ output: target in r3                          }
+{ side-effect: target := source                 }
+asm
+.LInterLockedXchgLoop:
+        lwarx   r10,0,r3
+        stwcx.  r4,0,r3
+        bne     .LInterLockedXchgLoop
+        mr      r3,r10
+end;
+
+
+function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
+{ input:  address of target in r3, source in r4 }
+{ output: target in r3                          }
+{ side-effect: target := target+source          }
+asm
+.LInterLockedXchgAddLoop:
+        lwarx   r10,0,r3
+        add     r10,r10,r4
+        stwcx.  r10,0,r3
+        bne     .LInterLockedXchgAddLoop
+        sub     r3,r10,r4
+end;
+