#include "Cmm.h" #include "GmpDerivedConstants.h" // TODO(superbobry): in the future release the syntax for calling // foreign funcations will CHANGE. import "integer-gmp" __gmpz_init_set; import "integer-gmp" __gmpz_popcount; import "integer-gmp" __gmpz_tstbit; import "integer-gmp" __gmpz_setbit; import "integer-gmp" __gmpz_clrbit; #define GMP_TAKE1_UL1_RET1(name,mp_fun) \ name \ { \ CInt s; \ W_ d; \ CLong ul; \ W_ mp_tmp; \ W_ mp_result; \ \ STK_CHK_GEN(2 * SIZEOF_MP_INT, R2, name); \ MAYBE_GC(R2_PTR, name); \ \ s = W_TO_INT(R1); \ d = R2; \ ul = R3; \ \ mp_tmp = Sp - 1 * SIZEOF_MP_INT; \ mp_result = Sp - 2 * SIZEOF_MP_INT; \ MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d)); \ MP_INT__mp_size(mp_tmp) = (s); \ MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d); \ \ foreign "C" __gmpz_init_set(mp_result "ptr", mp_tmp "ptr") [];\ \ /* Perform the operation */ \ foreign "C" mp_fun(mp_result "ptr", ul) []; \ \ RET_NP(TO_W_(MP_INT__mp_size(mp_result)), \ MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords); \ } GMP_TAKE1_UL1_RET1(integer_cmm_setBitIntegerzh, __gmpz_setbit) GMP_TAKE1_UL1_RET1(integer_cmm_clearBitIntegerzh, __gmpz_clrbit) integer_cmm_testBitIntegerzh { CInt s, res; CLong ul; W_ d; W_ mp_tmp; STK_CHK_GEN(SIZEOF_MP_INT, R2_PTR, integer_cmm_testBitIntegerzh); MAYBE_GC(R2_PTR, integer_cmm_testBitIntegerzh); s = W_TO_INT(R1); d = R2; ul = R3; mp_tmp = Sp - 1 * SIZEOF_MP_INT; MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d)); MP_INT__mp_size(mp_tmp) = (s); MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d); (res) = foreign "C" __gmpz_tstbit(mp_tmp "ptr", ul) []; RET_N(TO_W_(res)); } integer_cmm_popCountIntegerzh { CInt s, res; W_ d; W_ mp_tmp; STK_CHK_GEN(SIZEOF_MP_INT, R2_PTR, integer_cmm_popCountIntegerzh); MAYBE_GC(R2_PTR, integer_cmm_popCountIntegerzh); s = W_TO_INT(R1); d = R2; mp_tmp = Sp - 1 * SIZEOF_MP_INT; MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d)); MP_INT__mp_size(mp_tmp) = (s); MP_INT__mp_d(mp_tmp) = BYTE_ARR_CTS(d); (res) = foreign "C" __gmpz_popcount(mp_tmp "ptr") []; RET_N(TO_W_(res)); }