Commit b62bd5ec authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Implement `decodeDouble_Int64#` primop

The existing `decodeDouble_2Int#` primop is rather inconvenient to use
(and in fact is not even used by `integer-gmp`) as the mantissa is split
into 3 components which would actually fit in an `Int64#` value.

However, `decodeDouble_Int64#` is to be used by the new `integer-gmp2`
re-implementation (see #9281).

Moreover, `decodeDouble_2Int#` performs direct bit-wise operations on the
IEEE representation which can be replaced by a combination of the
portable standard C99 `scalbn(3)` and `frexp(3)` functions.

Differential Revision: https://phabricator.haskell.org/D160
parent 3c282901
......@@ -606,6 +606,11 @@ primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp
respectively, and the last is the exponent.}
with out_of_line = True
primop DoubleDecode_Int64Op "decodeDouble_Int64#" GenPrimOp
Double# -> (# INT64, Int# #)
{Decode {\tt Double\#} into mantissa and base-2 exponent.}
with out_of_line = True
------------------------------------------------------------------------
section "Float#"
{Operations on single-precision (32-bit) floating-point numbers.}
......
......@@ -341,6 +341,7 @@ RTS_FUN_DECL(StgReturn);
RTS_FUN_DECL(stg_decodeFloatzuIntzh);
RTS_FUN_DECL(stg_decodeDoublezu2Intzh);
RTS_FUN_DECL(stg_decodeDoublezuInt64zh);
RTS_FUN_DECL(stg_unsafeThawArrayzh);
RTS_FUN_DECL(stg_casArrayzh);
......
......@@ -1108,6 +1108,7 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(cmp_thread) \
SymI_HasProto(createAdjustor) \
SymI_HasProto(stg_decodeDoublezu2Intzh) \
SymI_HasProto(stg_decodeDoublezuInt64zh) \
SymI_HasProto(stg_decodeFloatzuIntzh) \
SymI_HasProto(defaultsHook) \
SymI_HasProto(stg_delayzh) \
......
......@@ -22,6 +22,7 @@
* ---------------------------------------------------------------------------*/
#include "Cmm.h"
#include "MachDeps.h"
#ifdef __PIC__
import pthread_mutex_lock;
......@@ -807,6 +808,22 @@ stg_decodeDoublezu2Intzh ( D_ arg )
return (r1, r2, r3, r4);
}
/* Double# -> (# Int64#, Int# #) */
stg_decodeDoublezuInt64zh ( D_ arg )
{
CInt exp;
I64 mant;
W_ mant_ptr;
STK_CHK_GEN_N (SIZEOF_INT64);
reserve BYTES_TO_WDS(SIZEOF_INT64) = mant_ptr {
(exp) = ccall __decodeDouble_Int64(mant_ptr "ptr", arg);
mant = I64[mant_ptr];
}
return (mant, TO_W_(exp));
}
/* -----------------------------------------------------------------------------
* Concurrency primitives
* -------------------------------------------------------------------------- */
......
......@@ -17,6 +17,10 @@
#define IEEE_FLOATING_POINT 1
#if FLT_RADIX != 2
# error FLT_RADIX != 2 not supported
#endif
/*
* Encoding and decoding Doubles. Code based on the HBC code
* (lib/fltcode.c).
......@@ -158,6 +162,20 @@ __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble
}
}
/* This is expected to replace uses of __decodeDouble_2Int() in the long run */
StgInt
__decodeDouble_Int64 (StgInt64 *const mantissa, const StgDouble dbl)
{
if (dbl) {
int exp = 0;
*mantissa = (StgInt64)scalbn(frexp(dbl, &exp), DBL_MANT_DIG);
return exp-DBL_MANT_DIG;
} else {
*mantissa = 0;
return 0;
}
}
/* Convenient union types for checking the layout of IEEE 754 types -
based on defs in GNU libc <ieee754.h>
*/
......
......@@ -12,6 +12,7 @@
#include "BeginPrivate.h"
/* grimy low-level support functions defined in StgPrimFloat.c */
StgInt __decodeDouble_Int64 (StgInt64 *mantissa, StgDouble dbl);
void __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl);
void __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt);
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment