* powerpc64 port from Thomas Schatzl

git-svn-id: trunk@1193 -

.gitattributes

@@ -326,6 +326,47 @@ compiler/powerpc/rppcsri.inc svneol=native#text/plain
 compiler/powerpc/rppcstab.inc svneol=native#text/plain
 compiler/powerpc/rppcstd.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.pas svneol=native#text/plain
 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/syscallh.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/ptypes.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/strpas.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.fpc svneol=native#text/plain
 rtl/solaris/errno.inc svneol=native#text/plain

compiler/cgbase.pas

@@ -53,9 +53,28 @@ interface
          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
        }

compiler/compiler.pas

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

compiler/fpcdefs.inc

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

compiler/globals.pas

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

compiler/options.pas

@@ -1854,6 +1854,16 @@ begin
   def_system_macro('FPC_CURRENCY_IS_INT64');
   def_system_macro('FPC_COMP_IS_INT64');
 {$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}
   def_system_macro('CPUIA64');
   def_system_macro('CPU64');

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.
+

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.

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.

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.
+

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.
+

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.
+

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.

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.
+

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.
+

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.
+

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.
+

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.
+

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.
+

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.
+

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.
+

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.
+

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.
+

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.
+

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.
+

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.
+

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.
+

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.
+

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
+;
+;

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
+;
+;

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.
+

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.
+

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.
+

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);

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

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'

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

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'

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'

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

compiler/powerpc64/rppcnor.inc

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

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)

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

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

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

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'

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;

compiler/pp.pas

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

compiler/psystem.pas

@@ -374,6 +374,12 @@ implementation
         s80floattype.setdef(tfloatdef.create(s80real));
         s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64)));
 {$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}
         s32floattype.setdef(tfloatdef.create(s32real));
         s64floattype.setdef(tfloatdef.create(s64real));

compiler/raatt.pas

@@ -276,6 +276,19 @@ unit raatt;
                end
            end;
 {$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 ? }
            If is_asmopcode(upper(actasmpattern)) then
             Begin

compiler/rautils.pas

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

compiler/symdef.pas

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

compiler/systems.pas

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

compiler/systems/i_linux.pas

@@ -293,6 +293,69 @@ unit i_linux;
             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       : system_alpha_LINUX;
@@ -577,11 +640,16 @@ initialization
     set_source_info(system_sparc_linux_info);
   {$endif linux}
 {$endif CPUSPARC}
-{$ifdef CPUPOWERPC}
+{$ifdef CPUPOWERPC32}
   {$ifdef linux}
     set_source_info(system_powerpc_linux_info);
   {$endif linux}
-{$endif CPUPOWERPC}
+{$endif CPUPOWERPC32}
+{$ifdef CPUPOWERPC64}
+  {$ifdef linux}
+    set_source_info(system_powerpc64_linux_info);
+  {$endif linux}
+{$endif CPUPOWERPC64}
 {$ifdef CPUARM}
   {$ifdef linux}
     set_source_info(system_arm_linux_info);

compiler/systems/t_linux.pas

@@ -207,6 +207,7 @@ const
 {$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 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 arm}    platform_select='';{$endif} {unknown :( }
 {$ifdef m68k}    platform_select='';{$endif} {unknown :( }
@@ -272,6 +273,11 @@ begin
      libctype:=glibc2;
 {$endif powerpc}
 
+{$ifdef powerpc64}
+     DynamicLinker:='/lib64/ld.so.1';
+     libctype:=glibc2;
+{$endif powerpc64}
+
 {$ifdef arm}
      DynamicLinker:='/lib/ld-linux.so.2';
      libctype:=glibc2;
@@ -709,6 +715,12 @@ initialization
   RegisterExport(system_powerpc_linux,texportliblinux);
   RegisterTarget(system_powerpc_linux_info);
 {$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}
   RegisterExternalLinker(system_alpha_linux_info,TLinkerLinux);
   RegisterImport(system_alpha_linux,timportliblinux);

compiler/tgobj.pas

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

compiler/version.pas

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

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.
+
+ **********************************************************************}
+
+

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
+

rtl/linux/powerpc64/dllprt0.as

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

rtl/linux/powerpc64/gprt0.as

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

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
+

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;
+

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;
+

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;
+

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;
+

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';
+

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;
+
+

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.
+
+ **********************************************************************}
+
+
+
+

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;
+

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.
+
+ **********************************************************************}

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.
+
+ **********************************************************************}
+

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;
+

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;
+
+
+
+

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;
+

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);
+

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}
+

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}
+

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;
+

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;
+

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;
+