bitset-1.4.8: cbits/gmp-extras.cmm

#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_setbit;
import "integer-gmp" __gmpz_clrbit;

#if __GLASGOW_HASKELL__ >= 707

#define GMP_TAKE1_UL1_RET1(name,mp_fun)                         \
name (W_ ws1, P_ d1, W_ wul)                                    \
{                                                               \
  CInt s1;                                                      \
  CLong ul;                                                     \
  W_ mp_tmp;                                                    \
  W_ mp_result;                                                 \
                                                                \
  /* call doYouWantToGC() */                                    \
again:                                                          \
  STK_CHK_GEN_N (2 * SIZEOF_MP_INT);                            \
  MAYBE_GC(again);                                              \
                                                                \
  s1 = W_TO_INT(ws1);                                           \
  ul = W_TO_LONG(wul);                                          \
                                                                \
  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(d1));        \
  MP_INT__mp_size(mp_tmp)  = (s1);                              \
  MP_INT__mp_d(mp_tmp)     = BYTE_ARR_CTS(d1);                  \
                                                                \
  ccall __gmpz_init_set(mp_result "ptr", mp_tmp "ptr");         \
                                                                \
  /* Perform the operation */                                   \
  ccall mp_fun(mp_result "ptr", ul);                            \
                                                                \
  return(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_popCountIntegerzh (W_ ws, W_ d)
{
  CInt s, res;
  W_ mp_tmp;

again:
  STK_CHK_P_LL(SIZEOF_MP_INT, integer_cmm_popCountIntegerzh, R2);
  MAYBE_GC(again);

  s = W_TO_INT(ws);

  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");

  return (TO_W_(res));
}
#else

#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));
}
#endif