paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 11:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Jonas Maebe 2003-04-26 20:36:24 +00:00
parent 19946413fe
commit 49497382c0
1 changed files with 89 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
rtl/powerpc/math.inc
View File

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