فهرست منبع

* trunc now also supports int64 (no NaN's etc though)

Jonas Maebe 22 سال پیش
والد
کامیت
49497382c0
1فایلهای تغییر یافته به همراه89 افزوده شده و 12 حذف شده
  1. 89 12
      rtl/powerpc/math.inc

+ 89 - 12
rtl/powerpc/math.inc

@@ -16,6 +16,12 @@
  **********************************************************************}
 
 
+const
+  longint_to_real_helper: int64 = $4330000080000000;
+  cardinal_to_real_helper: int64 = $430000000000000;
+  int_to_real_factor: double = double(high(cardinal))+1.0;
+
+
 {****************************************************************************
                        EXTENDED data type routines
  ****************************************************************************}
@@ -74,8 +80,11 @@
       end;
 
 
+      const
+        factor: double = double(int64(1) shl 32);
+        factor2: double = double(int64(1) shl 31);
+
     {$define FPC_SYSTEM_HAS_TRUNC}
-    {$warning FIX ME, trunc is working only for longint}
     function trunc(d : extended) : int64;assembler;[internconst:in_const_trunc];
       { input: d in fr1      }
       { output: result in r3 }
@@ -87,11 +96,81 @@
               1: (d: double);
           end;
       asm
-        fctiwz   f1,f1
-        stfd     f1,temp
-        xor	 r4,r4,r4
-        lwz      r3,4+temp
-      end ['R3','R4','F1'];
+        // 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    r3,factor@ha
+        lfd    f2,factor@l(r3)
+        {$else}
+        lwz    r3,factor[TC](r2)
+        lfd    f2,0(r3)
+        {$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      r4,4+temp
+        // convert back to float
+        lis      r0,0x4330
+        stw      r0,temp
+        xoris    r0,r4,0x8000
+        stw      r0,4+temp
+        {$ifndef macos}
+        lis    r3,longint_to_real_helper@ha
+        lfd    f0,longint_to_real_helper@l(r3)
+        {$else}
+        lwz    r3,longint_to_real_helper[TC](r2)
+        lfd    f0,0(r3)
+        {$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    r3,factor2@ha
+        lfd    f2,factor2@l(r3)
+        {$else}
+        lwz    r3,factor2[TC](r2)
+        lfd    f2,0(r3)
+        {$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    r3,4+temp
+        // add 2^31 if value was >=2^31
+        blt    cr1, LTruncNoAdd
+        xoris  r3,r3,0x8000
+LTruncNoAdd:
+        // negate value if it was negative to start with
+        beq    cr0,LTruncPositive
+        subfic r3,r3,0
+        subfze r4,r4
+LTruncPositive: 
+      end ['R3','R4','F1','F2','F3','F4'];
 
 
     {$define FPC_SYSTEM_HAS_ROUND}
@@ -209,11 +288,6 @@
                          Int to real helpers
  ****************************************************************************}
 
-const
-  longint_to_real_helper: int64 = $4330000080000000;
-  cardinal_to_real_helper: int64 = $430000000000000;
-  int_to_real_factor: double = double(high(cardinal))+1.0;
-
 function fpc_int64_to_double(i: int64): double; compilerproc;
 assembler;
 { input: high(i) in r3, low(i) in r4 }
@@ -296,7 +370,10 @@ end ['R0','R3','F0','F1','F2','F3'];
 
 {
   $Log$
-  Revision 1.18  2003-04-26 17:20:16  florian
+  Revision 1.19  2003-04-26 20:36:24  jonas
+    * trunc now also supports int64 (no NaN's etc though)
+
+  Revision 1.18  2003/04/26 17:20:16  florian
     * fixed trunc, now it's working at least for longint range
 
   Revision 1.17  2003/04/23 21:28:21  peter