diff options
| -rw-r--r-- | compiler/prelude/primops.txt.pp | 5 | ||||
| -rw-r--r-- | includes/stg/MiscClosures.h | 1 | ||||
| -rw-r--r-- | rts/Linker.c | 1 | ||||
| -rw-r--r-- | rts/PrimOps.cmm | 17 | ||||
| -rw-r--r-- | rts/StgPrimFloat.c | 18 | ||||
| -rw-r--r-- | rts/StgPrimFloat.h | 1 |
6 files changed, 43 insertions, 0 deletions
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index b78bc95353..a3c15a9c46 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -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.} diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index d2b933deb0..0d323e2db2 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -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); diff --git a/rts/Linker.c b/rts/Linker.c index dba346eb86..63cf981c58 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -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) \ diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index ee50f7fed5..cb4cd5e9fa 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -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 * -------------------------------------------------------------------------- */ diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index 123e77b806..6e78546b3e 100644 --- a/rts/StgPrimFloat.c +++ b/rts/StgPrimFloat.c @@ -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> */ diff --git a/rts/StgPrimFloat.h b/rts/StgPrimFloat.h index 57e9db1b91..d3911a13b9 100644 --- a/rts/StgPrimFloat.h +++ b/rts/StgPrimFloat.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); |