paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 10:49:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ int64_tof_loat conversion routines

Browse Source
This commit is contained in:
carl 2002-10-12 20:24:22 +00:00
parent f622e4f5a9
commit b701f612ed
1 changed files with 154 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

155
rtl/inc/softfpu.pp
View File

@ -63,16 +63,32 @@ TYPE
sbits16 = integer;
sbits32 = longint;
bits32 = longword;
{$ifndef fpc}
qword = int64;
{$endif}
uint64 = qword;
bits64 = qword;
sbits64 = int64;
{$ifdef ENDIAN_LITTLE}
float64 = packed record
low: bits32;
high: bits32;
end;
int64rec = packed record
low: bits32;
high: bits32;
end;
{$else}
float64 = packed record
high,low : bits32;
end;
int64rec = packed record
high,low : bits32;
end;
{$endif}
{*
@ -322,6 +338,20 @@ according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
*}
Function int32_to_float32( a: int32): float32;
{*----------------------------------------------------------------------------
| Returns the result of converting the 64-bit two's complement integer `a'
| to the double-precision floating-point format. The conversion is performed
| according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
*----------------------------------------------------------------------------*}
function int64_to_float64( a: int64 ): float64;
{*----------------------------------------------------------------------------
| Returns the result of converting the 64-bit two's complement integer `a'
| to the single-precision floating-point format. The conversion is performed
| according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
*----------------------------------------------------------------------------*}
function int64_to_float32( a: int64 ): float32;
CONST
{-------------------------------------------------------------------------------
@ -554,6 +584,9 @@ Begin
z0Ptr := z0;
End;
{*
-------------------------------------------------------------------------------
Shifts the 96-bit value formed by concatenating `a0', `a1', and `a2' right
@ -1040,6 +1073,26 @@ Begin
countLeadingZeros32:= shiftCount;
End;
{*----------------------------------------------------------------------------
| Returns the number of leading 0 bits before the most-significant 1 bit of
| `a'. If `a' is zero, 64 is returned.
*----------------------------------------------------------------------------*}
function countLeadingZeros64( a : bits64): int8;
var
shiftcount : int8;
Begin
shiftCount := 0;
if ( a < (bits64(1) shl 32 )) then
shiftCount := shiftcount + 32
else
a := a shr 32;
shiftCount := shiftCount + countLeadingZeros32( a );
countLeadingZeros64:= shiftCount;
End;
{*
-------------------------------------------------------------------------------
Returns 1 if the 64-bit value formed by concatenating `a0' and `a1' is
@ -4488,10 +4541,110 @@ Begin
float64_lt_quiet := lt64( a.high, a.low, b.high, b.low );
End;
{*----------------------------------------------------------------------------
| Returns the result of converting the 64-bit two's complement integer `a'
| to the single-precision floating-point format. The conversion is performed
| according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
*----------------------------------------------------------------------------*}
function int64_to_float32( a: int64 ): float32;
var
zSign : flag;
absA : uint64;
shiftCount: int8;
zSig : bits32;
intval : int64rec;
Begin
if ( a = 0 ) then
begin
int64_to_float32 := 0;
exit;
end;
if a < 0 then
zSign := flag(TRUE)
else
zSign := flag(FALSE);
if zSign<>0 then
absA := -a
else
absA := a;
shiftCount := countLeadingZeros64( absA ) - 40;
if ( 0 <= shiftCount ) then
begin
int64_to_float32:= packFloat32( zSign, $95 - shiftCount, absA shl shiftCount );
end
else
begin
shiftCount := shiftCount + 7;
if ( shiftCount < 0 ) then
begin
intval.low := int64rec(AbsA).low;
intval.high := int64rec(AbsA).high;
shift64RightJamming( intval.low, intval.high, - shiftCount,
intval.low, intval.high);
int64rec(absA).low := intval.low;
int64rec(absA).high := intval.high;
end
else
absA := absA shl shiftCount;
int64_to_float32:=roundAndPackFloat32( zSign, $9C - shiftCount, absA );
end;
End;
{*----------------------------------------------------------------------------
| Returns the result of converting the 64-bit two's complement integer `a'
| to the double-precision floating-point format. The conversion is performed
| according to the IEC/IEEE Standard for Binary Floating-Point Arithmetic.
*----------------------------------------------------------------------------*}
function int64_to_float64( a: int64 ): float64;
var
zSign : flag;
float_result : float64;
intval : int64rec;
Begin
if ( a = 0 ) then
begin
int64_to_float64.low := 0;
int64_to_float64.high := 0;
exit;
end;
if ( a = sbits64 ( 1 shl 64 ) ) then
begin
packFloat64(1, $43E, 0, 0, float_result);
int64_to_float64 := float_result;
exit;
end;
if a < 0 then
zSign := flag(TRUE)
else
zSign := flag(FALSE);
if zSign<>0 then
a := -a;
if zSign <> 0 then
begin
a:=-a;
intval.low := int64rec(a).low;
intval.high := int64rec(a).high;
normalizeRoundAndPackFloat64( zSign, $43C, intval.low, intval.high , float_result )
end
else
begin
intval.low := int64rec(a).low;
intval.high := int64rec(a).high;
normalizeRoundAndPackFloat64( zSign, $43C, intval.low, intval.high , float_result );
end;
int64_to_float64:= float_result;
End;
end.
{
$Log$
Revision 1.2 2002-10-08 20:07:08 carl
Revision 1.3 2002-10-12 20:24:22 carl
+ int64_tof_loat conversion routines
Revision 1.2 2002/10/08 20:07:08 carl
* fix range check errors
- overflow checking must be off always
* debugged and works as expected