|
@@ -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
|