initial import

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@1 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 355 insertions, 0 deletions

diff --git a/rtl/powerpc/math.inc b/rtl/powerpc/math.inc
new file mode 100644
index 0000000000..8e9081602b
--- /dev/null
+++ b/rtl/powerpc/math.inc
@@ -0,0 +1,355 @@
+{
+    $Id: math.inc,v 1.39 2005/02/14 17:13:31 peter Exp $
+    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: high(i) in r4, low(i) in r3 }
+{ output: double(i) in f0            }
+var
+  temp: packed record
+      case byte of
+        0: (l1,l2: cardinal);
+        1: (d: double);
+    end;
+asm
+           lis    r0,0x4330
+           stw    r0,temp
+           xoris  r3,r3,0x8000
+           stw    r3,temp+4
+           {$ifndef macos}
+           lis    r3,longint_to_real_helper@ha
+           lfd    f1,longint_to_real_helper@l(r3)
+           {$else}
+           lwz    r3,longint_to_real_helper(r2)
+           lfd    f1,0(r3)
+           {$endif}
+           lfd    f0,temp
+           stw    r4,temp+4
+           fsub   f0,f0,f1
+           {$ifndef macos}
+           lis    r4,cardinal_to_real_helper@ha
+           lfd    f1,cardinal_to_real_helper@l(r4)
+           lis    r4,int_to_real_factor@ha
+           lfd    f3,temp
+           lfd    f2,int_to_real_factor@l(r4)
+           {$else}
+           lwz    r4,cardinal_to_real_helper(r2)
+           lwz    r3,int_to_real_factor(r2)
+           lfd    f3,temp
+           lfd    f1,0(r4)
+           lfd    f2,0(r3)
+           {$endif}
+           fsub   f3,f3,f1
+           fmadd  f1,f0,f2,f3
+end;
+
+
+{$define FPC_SYSTEM_HAS_QWORD_TO_DOUBLE}
+function fpc_qword_to_double(q: qword): double; compilerproc;
+assembler;
+{ input: high(q) in r4, low(q) in r3 }
+{ output: double(q) in f0            }
+var
+  temp: packed record
+      case byte of
+        0: (l1,l2: cardinal);
+        1: (d: double);
+    end;
+asm
+           lis    r0,0x4330
+           stw    r0,temp
+           stw    r3,temp+4
+           lfd    f0,temp
+           {$ifndef macos}
+           lis    r3,cardinal_to_real_helper@ha
+           lfd    f1,cardinal_to_real_helper@l(r3)
+           {$else}
+           lwz    r3,longint_to_real_helper(r2)
+           lfd    f1,0(r3)
+           {$endif}
+           stw    r4,temp+4
+           fsub   f0,f0,f1
+           lfd    f3,temp
+           {$ifndef macos}
+           lis    r4,int_to_real_factor@ha
+           lfd    f2,int_to_real_factor@l(r4)
+           {$else}
+           lwz    r4,int_to_real_factor(r2)
+           lfd    f2,0(r4)
+           {$endif}
+           fsub   f3,f3,f1
+           fmadd  f1,f0,f2,f3
+end;
+
+
+{
+  $Log: math.inc,v $
+  Revision 1.39  2005/02/14 17:13:31  peter
+    * truncate log
+
+}