mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 16:49:07 +02:00
* trunc now also supports int64 (no NaN's etc though)
This commit is contained in:
parent
19946413fe
commit
49497382c0
@ -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
|
EXTENDED data type routines
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
@ -74,8 +80,11 @@
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
factor: double = double(int64(1) shl 32);
|
||||||
|
factor2: double = double(int64(1) shl 31);
|
||||||
|
|
||||||
{$define FPC_SYSTEM_HAS_TRUNC}
|
{$define FPC_SYSTEM_HAS_TRUNC}
|
||||||
{$warning FIX ME, trunc is working only for longint}
|
|
||||||
function trunc(d : extended) : int64;assembler;[internconst:in_const_trunc];
|
function trunc(d : extended) : int64;assembler;[internconst:in_const_trunc];
|
||||||
{ input: d in fr1 }
|
{ input: d in fr1 }
|
||||||
{ output: result in r3 }
|
{ output: result in r3 }
|
||||||
@ -87,11 +96,81 @@
|
|||||||
1: (d: double);
|
1: (d: double);
|
||||||
end;
|
end;
|
||||||
asm
|
asm
|
||||||
fctiwz f1,f1
|
// store d in temp
|
||||||
stfd f1,temp
|
stfd f1, temp
|
||||||
xor r4,r4,r4
|
// extract sign bit (record in cr0)
|
||||||
lwz r3,4+temp
|
lwz r3,temp
|
||||||
end ['R3','R4','F1'];
|
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}
|
{$define FPC_SYSTEM_HAS_ROUND}
|
||||||
@ -209,11 +288,6 @@
|
|||||||
Int to real helpers
|
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;
|
function fpc_int64_to_double(i: int64): double; compilerproc;
|
||||||
assembler;
|
assembler;
|
||||||
{ input: high(i) in r3, low(i) in r4 }
|
{ input: high(i) in r3, low(i) in r4 }
|
||||||
@ -296,7 +370,10 @@ end ['R0','R3','F0','F1','F2','F3'];
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* fixed trunc, now it's working at least for longint range
|
||||||
|
|
||||||
Revision 1.17 2003/04/23 21:28:21 peter
|
Revision 1.17 2003/04/23 21:28:21 peter
|
||||||
|
Loading…
Reference in New Issue
Block a user