primop Float2DoubleOp "float2Double#" GenPrimOp Float# -> Double#
-primop FloatDecodeOp "decodeFloat#" GenPrimOp
- Float# -> (# Int#, Int#, ByteArray# #)
- {Convert to arbitrary-precision integer.
- First {\tt Int\#} in result is the exponent; second {\tt Int\#} and {\tt ByteArray\#}
- represent an {\tt Integer\#} holding the mantissa.}
- with out_of_line = True
-
primop FloatDecode_IntOp "decodeFloat_Int#" GenPrimOp
Float# -> (# Int#, Int# #)
- {Convert to arbitrary-precision integer.
+ {Convert to integers.
First {\tt Int\#} in result is the mantissa; second is the exponent.}
with out_of_line = True
extern void stackOverflow(void);
extern void __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl);
-extern void __decodeFloat (MP_INT *man, I_ *_exp, StgFloat flt);
extern void __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl);
extern void __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt);
RTS_FUN(int2Integerzh_fast);
RTS_FUN(word2Integerzh_fast);
-RTS_FUN(decodeFloatzh_fast);
RTS_FUN(decodeFloatzuIntzh_fast);
RTS_FUN(decodeDoublezh_fast);
RTS_FUN(decodeDoublezu2Intzh_fast);
SymI_HasProto(complementIntegerzh_fast) \
SymI_HasProto(createAdjustor) \
SymI_HasProto(decodeDoublezh_fast) \
- SymI_HasProto(decodeFloatzh_fast) \
SymI_HasProto(decodeDoublezu2Intzh_fast) \
SymI_HasProto(decodeFloatzuIntzh_fast) \
SymI_HasProto(defaultsHook) \
jump %ENTRY_CODE(Sp(0));
}
-decodeFloatzh_fast
-{
- W_ p;
- F_ arg;
- FETCH_MP_TEMP(mp_tmp1);
- FETCH_MP_TEMP(mp_tmp_w);
-
- /* arguments: F1 = Float# */
- arg = F1;
-
- ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, decodeFloatzh_fast );
-
- /* Be prepared to tell Lennart-coded __decodeFloat
- where mantissa._mp_d can be put (it does not care about the rest) */
- p = Hp - SIZEOF_StgArrWords;
- SET_HDR(p,stg_ARR_WORDS_info,W_[CCCS]);
- StgArrWords_words(p) = 1;
- MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p);
-
- /* Perform the operation */
- foreign "C" __decodeFloat(mp_tmp1 "ptr",mp_tmp_w "ptr" ,arg) [];
-
- /* returns: (Int# (expn), Int#, ByteArray#) */
- RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
-}
-
decodeFloatzuIntzh_fast
{
W_ p;
}
}
-void
-__decodeFloat (MP_INT *man, I_ *exp, StgFloat flt)
-{
- /* Do some bit fiddling on IEEE */
- int high, sign; /* assuming 32 bit ints */
- union { float f; int i; } u; /* assuming 32 bit float and int */
-
- ASSERT(sizeof(int ) == 4 );
- ASSERT(sizeof(flt ) == SIZEOF_FLOAT );
- ASSERT(sizeof(man->_mp_d[0]) == SIZEOF_LIMB_T);
- ASSERT(FNBIGIT*SIZEOF_LIMB_T >= SIZEOF_FLOAT );
-
- u.f = flt; /* grab the float */
- high = u.i;
-
- /* we know the MP_INT* passed in has size zero, so we realloc
- no matter what.
- */
- man->_mp_alloc = FNBIGIT;
-
- if ((high & ~FMSBIT) == 0) {
- man->_mp_size = 0;
- *exp = 0;
- } else {
- man->_mp_size = FNBIGIT;
- *exp = ((high >> 23) & 0xff) + MY_FMINEXP;
- sign = high;
-
- high &= FHIGHBIT-1;
- if (*exp != MY_FMINEXP) /* don't add hidden bit to denorms */
- high |= FHIGHBIT;
- else {
- (*exp)++;
- /* A denorm, normalize the mantissa */
- while (! (high & FHIGHBIT)) {
- high <<= 1;
- (*exp)--;
- }
- }
-#if FNBIGIT == 1
- man->_mp_d[0] = (mp_limb_t)high;
-#else
-#error Cannot cope with FNBIGIT
-#endif
- if (sign < 0)
- man->_mp_size = -man->_mp_size;
- }
-}
-
/* Convenient union types for checking the layout of IEEE 754 types -
based on defs in GNU libc <ieee754.h>
*/