Ticket #8647: 0001-Allocate-initial-1-limb-mpz_t-on-the-Cmm-Stack-re-86.patch

File 0001-Allocate-initial-1-limb-mpz_t-on-the-Cmm-Stack-re-86.patch, 33.6 KB (added by hvr, 3 months ago)

experimental patch for review (see also comment in patch header)

  • GHC/Integer/Type.lhs

    From d4212560b1734ee13242486710dec66248d6b540 Mon Sep 17 00:00:00 2001
    From: Herbert Valerio Riedel <hvr@gnu.org>
    Date: Tue, 7 Jan 2014 13:04:41 +0100
    Subject: [PATCH] Allocate initial 1-limb mpz_t on the Cmm Stack (re #8647)
    
    This is work-in-progress
    
    We now allocate a 1-limb mpz_t on the stack instead of doing a more
    expensive heap-allocation (especially if the heap-allocated copy becomes
    garbage right away)
    
    The actual hack occurs in the pair returned from the primitives:
    
    A tuple (# s::Int#, w::Word# (or d::ByteArray#) #) is returned, where
    the value of the first element defines the type of the second element,
    i.e.:
    
     *  (#  0, 0 :: Word# #) -> value = 0
     *  (#  1, w :: Word# #) -> value = w
     *  (# -1, w :: Word# #) -> value = -w
     *  (#  s, d :: ByteArray# #) -> value = J# s d
    
    Signed-off-by: Herbert Valerio Riedel <hvr@gnu.org>
    ---
     GHC/Integer/Type.lhs   | 147 ++++++++++++++++++++-----------------------
     cbits/gmp-wrappers.cmm | 166 +++++++++++++++++++++++++++++++++++--------------
     2 files changed, 185 insertions(+), 128 deletions(-)
    
    diff --git a/GHC/Integer/Type.lhs b/GHC/Integer/Type.lhs
    index 0e3cec7..39a5c94 100644
    a b module GHC.Integer.Type where 
    2424import GHC.Prim ( 
    2525    -- Other types we use, convert from, or convert to 
    2626    Int#, Word#, Double#, Float#, ByteArray#, MutableByteArray#, Addr#, State#, 
    27     indexIntArray#, 
     27    indexIntArray#, unsafeCoerce#, 
    2828    -- Conversions between those types 
    2929    int2Word#, int2Double#, int2Float#, word2Int#, 
    3030    -- Operations on Int# that we use for operations on S# 
    smartJ# (-1#) mb# | isTrue# (v <# 0#) = S# v 
    167167    where 
    168168      v = negateInt# (indexIntArray# mb# 0#) 
    169169smartJ# s# mb# = J# s# mb# 
     170 
     171-- |Construct 'Integer' out of 3-tuple returned by GMP wrapper primops 
     172-- 
     173-- TODO: try to move tupToInteger into gmp-wrapper.cmm 
     174-- 
     175-- See also MP_INT_1LIMB_RETURN() macro in gmp-wrappers.cmm 
     176tupToInteger :: (# Int#, ByteArray# #) -> Integer 
     177tupToInteger (# 0#, _ #) = S# 0# 
     178tupToInteger (# 1#, w'# #) | isTrue# (v# >=# 0#) = S# v# 
     179                           | True = case word2Integer# w# of (# _, d #) -> J# 1# d 
     180    where 
     181      !v# = word2Int# w# 
     182      !w# = unsafeCoerce# w'# 
     183tupToInteger (# -1#, w'# #) | isTrue# (v# <=# 0#) = S# v# 
     184                            | True = case word2Integer# w# of (# _, d #) -> J# -1# d 
     185    where 
     186      !v# = negateInt# (word2Int# w#) 
     187      !w# = unsafeCoerce# w'# 
     188tupToInteger (# s#, mb# #) = J# s# mb# 
     189 
     190-- | Variant of tupToInteger for a pair of Integers 
     191tupToInteger2 :: (# Int#, ByteArray#, Int#, ByteArray# #) -> (# Integer, Integer #) 
     192tupToInteger2 (# s1,w1, s2,w2 #) = (# i1, i2 #) 
     193    where 
     194      !i1 = tupToInteger (# s1,w1 #) 
     195      !i2 = tupToInteger (# s2,w2 #) 
     196 
    170197\end{code} 
    171198 
    172199Note [Use S# if possible] 
    quotRemInteger (S# i) (S# j) = case quotRemInt# i j of 
    222249quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2) 
    223250quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2 
    224251quotRemInteger (J# s1 d1) (J# s2 d2) 
    225   = case (quotRemInteger# s1 d1 s2 d2) of 
    226           (# s3, d3, s4, d4 #) -> let !q = smartJ# s3 d3 
    227                                       !r = smartJ# s4 d4 
    228                                   in (# q, r #) 
    229                            -- See Note [Use S# if possible] 
     252  = tupToInteger2 (quotRemInteger# s1 d1 s2 d2) 
     253    -- See Note [Use S# if possible] 
    230254 
    231255{-# NOINLINE divModInteger #-} 
    232256divModInteger :: Integer -> Integer -> (# Integer, Integer #) 
    divModInteger (S# i) (S# j) = (# S# d, S# m #) 
    242266 
    243267divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2) 
    244268divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2 
    245 divModInteger (J# s1 d1) (J# s2 d2) 
    246   = case (divModInteger# s1 d1 s2 d2) of 
    247           (# s3, d3, s4, d4 #) -> let !q = smartJ# s3 d3 
    248                                       !r = smartJ# s4 d4 
    249                                   in (# q, r #) 
     269divModInteger (J# s1 d1) (J# s2 d2) = tupToInteger2 (divModInteger# s1 d1 s2 d2) 
    250270 
    251271{-# NOINLINE remInteger #-} 
    252272remInteger :: Integer -> Integer -> Integer 
    remInteger ia@(S# a) (J# sb b) 
    263283remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib 
    264284remInteger (J# sa a) (S# b) 
    265285  = case int2Integer# b of { (# sb, b' #) -> 
    266     case remInteger# sa a sb b' of { (# sr, r #) -> 
    267     S# (integer2Int# sr r) }} 
    268 remInteger (J# sa a) (J# sb b) 
    269   = case remInteger# sa a sb b of (# sr, r #) -> smartJ# sr r 
     286    tupToInteger (remInteger# sa a sb b') } 
     287remInteger (J# sa a) (J# sb b) = tupToInteger (remInteger# sa a sb b) 
    270288 
    271289{-# NOINLINE quotInteger #-} 
    272290quotInteger :: Integer -> Integer -> Integer 
    quotInteger (S# a) (J# sb b) 
    280298-} 
    281299quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib 
    282300quotInteger (J# sa a) (S# b) 
    283   = case int2Integer# b of { (# sb, b' #) -> 
    284     case quotInteger# sa a sb b' of (# sq, q #) -> smartJ# sq q } 
     301  = case int2Integer# b of { (# sb, b' #) -> tupToInteger (quotInteger# sa a sb b') } 
    285302quotInteger (J# sa a) (J# sb b) 
    286   = case quotInteger# sa a sb b of (# sg, g #) -> smartJ# sg g 
     303  = tupToInteger (quotInteger# sa a sb b) 
    287304 
    288305{-# NOINLINE modInteger #-} 
    289306modInteger :: Integer -> Integer -> Integer 
    modInteger (S# a) (S# b) = S# (modInt# a b) 
    292309modInteger ia@(S# _) ib@(J# _ _) = modInteger (toBig ia) ib 
    293310modInteger (J# sa a) (S# b) 
    294311  = case int2Integer# b of { (# sb, b' #) -> 
    295     case modInteger# sa a sb b' of { (# sr, r #) -> 
    296     S# (integer2Int# sr r) }} 
     312    tupToInteger (modInteger# sa a sb b') } 
    297313modInteger (J# sa a) (J# sb b) 
    298   = case modInteger# sa a sb b of (# sr, r #) -> smartJ# sr r 
     314  = tupToInteger (modInteger# sa a sb b) 
    299315 
    300316{-# NOINLINE divInteger #-} 
    301317divInteger :: Integer -> Integer -> Integer 
    divInteger a@(S# INT_MINBOUND) b = divInteger (toBig a) b 
    303319divInteger (S# a) (S# b) = S# (divInt# a b) 
    304320divInteger ia@(S# _) ib@(J# _ _) = divInteger (toBig ia) ib 
    305321divInteger (J# sa a) (S# b) 
    306   = case int2Integer# b of { (# sb, b' #) -> 
    307     case divInteger# sa a sb b' of (# sq, q #) -> smartJ# sq q } 
     322  = case int2Integer# b of { (# sb, b' #) -> tupToInteger (divInteger# sa a sb b') } 
    308323divInteger (J# sa a) (J# sb b) 
    309   = case divInteger# sa a sb b of (# sg, g #) -> smartJ# sg g 
     324  = tupToInteger (divInteger# sa a sb b) 
    310325\end{code} 
    311326 
    312327 
    gcdInteger ia@(S# a) ib@(J# sb b) 
    326341       where !absA  = if isTrue# (a  <# 0#) then negateInt# a  else a 
    327342             !absSb = if isTrue# (sb <# 0#) then negateInt# sb else sb 
    328343gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia 
    329 gcdInteger (J# sa a) (J# sb b) 
    330   = case gcdInteger# sa a sb b of (# sg, g #) -> smartJ# sg g 
     344gcdInteger (J# sa a) (J# sb b)   = tupToInteger (gcdInteger# sa a sb b) 
    331345 
    332346-- | Extended euclidean algorithm. 
    333347-- 
    gcdExtInteger :: Integer -> Integer -> (# Integer, Integer #) 
    338352gcdExtInteger a@(S# _)   b@(S# _) = gcdExtInteger (toBig a) (toBig b) 
    339353gcdExtInteger a@(S# _) b@(J# _ _) = gcdExtInteger (toBig a) b 
    340354gcdExtInteger a@(J# _ _) b@(S# _) = gcdExtInteger a (toBig b) 
    341 gcdExtInteger (J# sa a) (J# sb b) 
    342   = case gcdExtInteger# sa a sb b of 
    343       (# sg, g, ss, s #) -> let !g' = smartJ# sg g 
    344                                 !s' = smartJ# ss s 
    345                             in (# g', s' #) 
     355gcdExtInteger (J# sa a) (J# sb b) = tupToInteger2 (gcdExtInteger# sa a sb b) 
    346356 
    347357-- | Compute least common multiple. 
    348358{-# NOINLINE lcmInteger #-} 
    divExact (S# a) (J# sb b) 
    369379  = S# (quotInt# a (integer2Int# sb b)) 
    370380divExact (J# sa a) (S# b) 
    371381  = case int2Integer# b of 
    372     (# sb, b' #) -> case divExactInteger# sa a sb b' of 
    373                     (# sd, d #) -> smartJ# sd d 
    374 divExact (J# sa a) (J# sb b) 
    375   = case divExactInteger# sa a sb b of (# sd, d #) -> smartJ# sd d 
     382    (# sb, b' #) -> tupToInteger (divExactInteger# sa a sb b') 
     383divExact (J# sa a) (J# sb b) = tupToInteger (divExactInteger# sa a sb b) 
    376384\end{code} 
    377385 
    378386 
    plusInteger (S# i) (S# j) = case addIntC# i j of 
    511519                                       if isTrue# (c ==# 0#) 
    512520                                       then S# r 
    513521                                       else case int2Integer# i of 
    514                                             (# s, d #) -> case plusIntegerInt# s d j of 
    515                                                           (# s', d' #) -> J# s' d' 
     522                                            (# s, d #) -> tupToInteger (plusIntegerInt# s d j) 
    516523plusInteger i1@(J# _ _) (S# 0#)   = i1 
    517 plusInteger (J# s1 d1)  (S# j)    = case plusIntegerInt# s1 d1 j of 
    518                                     (# s, d #) -> smartJ# s d 
     524plusInteger (J# s1 d1)  (S# j)    = tupToInteger (plusIntegerInt# s1 d1 j) 
    519525plusInteger i1@(S# _) i2@(J# _ _) = plusInteger i2 i1 
    520 plusInteger (J# s1 d1) (J# s2 d2) = case plusInteger# s1 d1 s2 d2 of 
    521                                     (# s, d #) -> smartJ# s d 
     526plusInteger (J# s1 d1) (J# s2 d2) = tupToInteger (plusInteger# s1 d1 s2 d2) 
    522527 
    523528{-# NOINLINE minusInteger #-} 
    524529minusInteger :: Integer -> Integer -> Integer 
    minusInteger (S# i) (S# j) = case subIntC# i j of 
    526531                                     (# r, c #) -> 
    527532                                         if isTrue# (c ==# 0#) then S# r 
    528533                                         else case int2Integer# i of 
    529                                               (# s, d #) -> case minusIntegerInt# s d j of 
    530                                                             (# s', d' #) -> J# s' d' 
     534                                              (# s, d #) -> tupToInteger (minusIntegerInt# s d j) 
    531535minusInteger i1@(J# _ _) (S# 0#)   = i1 
    532 minusInteger (J# s1 d1)  (S# j)    = case minusIntegerInt# s1 d1 j of 
    533                                      (# s, d #) -> smartJ# s d 
     536minusInteger (J# s1 d1)  (S# j)    = tupToInteger (minusIntegerInt# s1 d1 j) 
    534537minusInteger (S# 0#)    (J# s2 d2) = J# (negateInt# s2) d2 
    535 minusInteger (S# i)     (J# s2 d2) = case plusIntegerInt# (negateInt# s2) d2 i of 
    536                                      (# s, d #) -> smartJ# s d 
    537 minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of 
    538                                      (# s, d #) -> smartJ# s d 
     538minusInteger (S# i)     (J# s2 d2) = tupToInteger (plusIntegerInt# (negateInt# s2) d2 i) 
     539minusInteger (J# s1 d1) (J# s2 d2) = tupToInteger (minusInteger# s1 d1 s2 d2) 
    539540 
    540541{-# NOINLINE timesInteger #-} 
    541542timesInteger :: Integer -> Integer -> Integer 
    542543timesInteger (S# i) (S# j)         = if isTrue# (mulIntMayOflo# i j ==# 0#) 
    543544                                     then S# (i *# j) 
    544545                                     else case int2Integer# i of 
    545                                           (# s, d #) -> case timesIntegerInt# s d j of 
    546                                                         (# s', d' #) -> smartJ# s' d' 
     546                                          (# s, d #) -> tupToInteger (timesIntegerInt# s d j) 
    547547timesInteger (S# 0#)     _         = S# 0# 
    548548timesInteger (S# -1#)    i2        = negateInteger i2 
    549549timesInteger (S# 1#)     i2        = i2 
    550 timesInteger (S# i1)    (J# s2 d2) = case timesIntegerInt# s2 d2 i1 of 
    551                                      (# s, d #) -> J# s d 
     550timesInteger (S# i1)    (J# s2 d2) = tupToInteger (timesIntegerInt# s2 d2 i1) 
    552551timesInteger i1@(J# _ _) i2@(S# _) = timesInteger i2 i1 -- swap args & retry 
    553 timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of 
    554                                      (# s, d #) -> J# s d 
     552timesInteger (J# s1 d1) (J# s2 d2) = tupToInteger (timesInteger# s1 d1 s2 d2) 
    555553 
    556554{-# NOINLINE negateInteger #-} 
    557555negateInteger :: Integer -> Integer 
    andInteger :: Integer -> Integer -> Integer 
    627625(S# x)     `andInteger`   (S# y)     = S# (word2Int# (int2Word# x `and#` int2Word# y)) 
    628626x@(S# _)   `andInteger` y@(J# _ _)   = toBig x `andInteger` y 
    629627x@(J# _ _) `andInteger` y@(S# _)     = x `andInteger` toBig y 
    630 (J# s1 d1) `andInteger`   (J# s2 d2) = 
    631      case andInteger# s1 d1 s2 d2 of 
    632        (# s, d #) -> smartJ# s d 
     628(J# s1 d1) `andInteger`   (J# s2 d2) = tupToInteger (andInteger# s1 d1 s2 d2) 
    633629 
    634630{-# NOINLINE orInteger #-} 
    635631orInteger :: Integer -> Integer -> Integer 
    636632(S# x)     `orInteger`   (S# y)     = S# (word2Int# (int2Word# x `or#` int2Word# y)) 
    637633x@(S# _)   `orInteger` y@(J# _ _)   = toBig x `orInteger` y 
    638634x@(J# _ _) `orInteger` y@(S# _)     = x `orInteger` toBig y 
    639 (J# s1 d1) `orInteger`   (J# s2 d2) = 
    640      case orInteger# s1 d1 s2 d2 of 
    641        (# s, d #) -> J# s d 
     635(J# s1 d1) `orInteger`   (J# s2 d2) = tupToInteger (orInteger# s1 d1 s2 d2) 
    642636 
    643637{-# NOINLINE xorInteger #-} 
    644638xorInteger :: Integer -> Integer -> Integer 
    645639(S# x)     `xorInteger`   (S# y)     = S# (word2Int# (int2Word# x `xor#` int2Word# y)) 
    646640x@(S# _)   `xorInteger` y@(J# _ _)   = toBig x `xorInteger` y 
    647641x@(J# _ _) `xorInteger` y@(S# _)     = x `xorInteger` toBig y 
    648 (J# s1 d1) `xorInteger`   (J# s2 d2) = 
    649      case xorInteger# s1 d1 s2 d2 of 
    650        (# s, d #) -> smartJ# s d 
     642(J# s1 d1) `xorInteger`   (J# s2 d2) = tupToInteger (xorInteger# s1 d1 s2 d2) 
    651643 
    652644{-# NOINLINE complementInteger #-} 
    653645complementInteger :: Integer -> Integer 
    654646complementInteger (S# x) 
    655647    = S# (word2Int# (int2Word# x `xor#` int2Word# (0# -# 1#))) 
    656648complementInteger (J# s d) 
    657     = case complementInteger# s d of (# s', d' #) -> smartJ# s' d' 
     649    = tupToInteger (complementInteger# s d) 
    658650 
    659651{-# NOINLINE shiftLInteger #-} 
    660652shiftLInteger :: Integer -> Int# -> Integer 
    661653shiftLInteger j@(S# _) i = shiftLInteger (toBig j) i 
    662 shiftLInteger (J# s d) i = case mul2ExpInteger# s d i of 
    663                            (# s', d' #) -> J# s' d' 
     654shiftLInteger (J# s d) i = tupToInteger (mul2ExpInteger# s d i) 
    664655 
    665656{-# NOINLINE shiftRInteger #-} 
    666657shiftRInteger :: Integer -> Int# -> Integer 
    667658shiftRInteger j@(S# _) i = shiftRInteger (toBig j) i 
    668 shiftRInteger (J# s d) i = case fdivQ2ExpInteger# s d i of 
    669                            (# s', d' #) -> smartJ# s' d' 
     659shiftRInteger (J# s d) i = tupToInteger (fdivQ2ExpInteger# s d i) 
    670660 
    671661{-# NOINLINE testBitInteger #-} 
    672662testBitInteger :: Integer -> Int# -> Bool 
    testBitInteger (J# s d) i = isTrue# (testBitInteger# s d i /=# 0#) 
    677667{-# NOINLINE powInteger #-} 
    678668powInteger :: Integer -> Word# -> Integer 
    679669powInteger j@(S# _) e = powInteger (toBig j) e 
    680 powInteger (J# s d) e = case powInteger# s d e of 
    681                             (# s', d' #) -> smartJ# s' d' 
     670powInteger (J# s d) e = tupToInteger (powInteger# s d e) 
    682671 
    683672-- | \"@'powModInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to 
    684673-- exponent @/e/@ modulo @/m/@. 
    powInteger (J# s d) e = case powInteger# s d e of 
    691680{-# NOINLINE powModInteger #-} 
    692681powModInteger :: Integer -> Integer -> Integer -> Integer 
    693682powModInteger (J# s1 d1) (J# s2 d2) (J# s3 d3) = 
    694     case powModInteger# s1 d1 s2 d2 s3 d3 of 
    695         (# s', d' #) -> smartJ# s' d' 
     683    tupToInteger (powModInteger# s1 d1 s2 d2 s3 d3) 
    696684powModInteger b e m = powModInteger (toBig b) (toBig e) (toBig m) 
    697685 
    698686-- | \"@'powModSecInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to 
    powModInteger b e m = powModInteger (toBig b) (toBig e) (toBig m) 
    706694{-# NOINLINE powModSecInteger #-} 
    707695powModSecInteger :: Integer -> Integer -> Integer -> Integer 
    708696powModSecInteger (J# s1 d1) (J# s2 d2) (J# s3 d3) = 
    709     case powModSecInteger# s1 d1 s2 d2 s3 d3 of 
    710         (# s', d' #) -> J# s' d' 
     697    tupToInteger (powModSecInteger# s1 d1 s2 d2 s3 d3) 
    711698powModSecInteger b e m = powModSecInteger (toBig b) (toBig e) (toBig m) 
    712699 
    713700-- | \"@'recipModInteger' /x/ /m/@\" computes the inverse of @/x/@ modulo @/m/@. If 
    recipModInteger :: Integer -> Integer -> Integer 
    722709recipModInteger j@(S# _) m@(S# _)   = recipModInteger (toBig j) (toBig m) 
    723710recipModInteger j@(S# _) m@(J# _ _) = recipModInteger (toBig j) m 
    724711recipModInteger j@(J# _ _) m@(S# _) = recipModInteger j (toBig m) 
    725 recipModInteger (J# s d) (J# ms md) = case recipModInteger# s d ms md of 
    726                            (# s', d' #) -> smartJ# s' d' 
     712recipModInteger (J# s d) (J# ms md) = tupToInteger (recipModInteger# s d ms md) 
    727713 
    728714-- | Probalistic Miller-Rabin primality test. 
    729715-- 
    testPrimeInteger (J# s d) reps = testPrimeInteger# s d reps 
    753739{-# NOINLINE nextPrimeInteger #-} 
    754740nextPrimeInteger :: Integer -> Integer 
    755741nextPrimeInteger j@(S# _) = nextPrimeInteger (toBig j) 
    756 nextPrimeInteger (J# s d) = case nextPrimeInteger# s d of (# s', d' #) -> smartJ# s' d' 
     742nextPrimeInteger (J# s d) = tupToInteger (nextPrimeInteger# s d) 
    757743 
    758744-- | Compute number of digits (without sign) in given @/base/@. 
    759745-- 
    exportIntegerToAddr j@(S# _) addr o e = exportIntegerToAddr (toBig j) addr o e - 
    843829-- * returns a new 'Integer' 
    844830{-# NOINLINE importIntegerFromByteArray #-} 
    845831importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer 
    846 importIntegerFromByteArray ba o l e = case importIntegerFromByteArray# ba o l e of (# s', d' #) -> smartJ# s' d' 
     832importIntegerFromByteArray ba o l e = tupToInteger (importIntegerFromByteArray# ba o l e) 
    847833 
    848834-- | Read 'Integer' (without sign) from memory location at @/addr/@ in 
    849835-- base-256 representation. 
    importIntegerFromByteArray ba o l e = case importIntegerFromByteArray# ba o l e 
    856842{-# NOINLINE importIntegerFromAddr #-} 
    857843importIntegerFromAddr :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Integer #) 
    858844importIntegerFromAddr addr l e st = case importIntegerFromAddr# addr l e st of 
    859                                       (# st', s', d' #) -> let !j = smartJ# s' d' in (# st', j #) 
     845                                      (# st', s', w' #) -> let !j = tupToInteger (# s', w' #) 
     846                                                               in (# st', j #) 
    860847 
    861848\end{code} 
    862849 
  • cbits/gmp-wrappers.cmm

    diff --git a/cbits/gmp-wrappers.cmm b/cbits/gmp-wrappers.cmm
    index 3ab699e..c92d8be 100644
    a b import "integer-gmp" integer_cbits_decodeDouble; 
    8282#define MP_INT_AS_PAIR(mp_ptr) \ 
    8383  TO_W_(MP_INT__mp_size(mp_ptr)),(MP_INT__mp_d(mp_ptr)-SIZEOF_StgArrWords) 
    8484 
     85#define MP_INT_TO_BA(mp_ptr) \ 
     86  (MP_INT__mp_d(mp_ptr)-SIZEOF_StgArrWords) 
     87 
     88/* Size of mpz_t with single limb */ 
     89#define SIZEOF_MP_INT_1LIMB (SIZEOF_MP_INT+WDS(1)) 
     90 
     91/* Initialize 0-valued single-limb mpz_t at mp_ptr */ 
     92#define MP_INT_1LIMB_INIT0(mp_ptr)                       \ 
     93  MP_INT__mp_alloc(mp_ptr) = W_TO_INT(1);                \ 
     94  MP_INT__mp_size(mp_ptr)  = W_TO_INT(0);                \ 
     95  MP_INT__mp_d(mp_ptr)     = (mp_ptr+SIZEOF_MP_INT) 
     96 
     97/* Initialize positive single-limb mpz_t at mp_ptr 
     98   sgn MUST be -1 or 1, absval MUST NOT not be 0 */ 
     99#define MP_INT_1LIMB_INIT(mp_ptr,sgn,absval)             \ 
     100  MP_INT__mp_alloc(mp_ptr) = W_TO_INT(1);                \ 
     101  MP_INT__mp_size(mp_ptr)  = W_TO_INT(sgn);              \ 
     102  MP_INT__mp_d(mp_ptr)     = (mp_ptr+SIZEOF_MP_INT);     \ 
     103  W_[mp_ptr+SIZEOF_MP_INT] = absval 
     104 
     105 
     106 
     107/* return mpz_t as (# Int#, (ByteArray# | Word#) #) tuple 
     108 * 
     109 * semantics: 
     110 * 
     111 *  (#  0, 0 :: Word# #)      -> value = 0 
     112 *  (#  1, w :: Word# #)      -> value = w 
     113 *  (# -1, w :: Word# #)      -> value = -w 
     114 *  (#  s, d :: ByteArray# #) -> value = J# s d 
     115 * 
     116 */ 
     117#define MP_INT_1LIMB_RETURN(mp_ptr)                    \ 
     118  CInt __mp_s;                                         \ 
     119  __mp_s = MP_INT__mp_size(mp_ptr);                    \ 
     120                                                       \ 
     121  if (__mp_s == W_TO_INT(0))                           \ 
     122  {                                                    \ 
     123    return (0,0);                                      \ 
     124  }                                                    \ 
     125                                                       \ 
     126  if (__mp_s == W_TO_INT(-1) || __mp_s == W_TO_INT(1)) \ 
     127  {                                                    \ 
     128    return (TO_W_(__mp_s),W_[MP_INT__mp_d(mp_ptr)]);   \ 
     129  }                                                    \ 
     130                                                       \ 
     131  return (TO_W_(__mp_s),MP_INT_TO_BA(mp_ptr)) 
     132 
     133/* Helper macro used by MP_INT_1LIMB_RETURN2 */ 
     134#define MP_INT_1LIMB_AS_TUP(s,d,mp_ptr)        \ 
     135  CInt s; W_ d; s = MP_INT__mp_size(mp_ptr);   \ 
     136                                               \ 
     137  if (s == W_TO_INT(0))                        \ 
     138  {                                            \ 
     139    d = 0;                                     \ 
     140  } else {                                     \ 
     141    if (s == W_TO_INT(-1) || s == W_TO_INT(1)) \ 
     142    {                                          \ 
     143      d = W_[MP_INT__mp_d(mp_ptr)];            \ 
     144    } else {                                   \ 
     145      d = MP_INT_TO_BA(mp_ptr);                \ 
     146    }                                          \ 
     147  } 
     148 
     149#define MP_INT_1LIMB_RETURN2(mp_ptr1,mp_ptr2)  \ 
     150  MP_INT_1LIMB_AS_TUP(__r1s,__r1d,mp_ptr1);    \ 
     151  MP_INT_1LIMB_AS_TUP(__r2s,__r2d,mp_ptr2);    \ 
     152  return (TO_W_(__r1s),__r1d, TO_W_(__r2s),__r2d) 
    85153 
    86154/* :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #) */ 
    87155integer_cmm_importIntegerFromByteArrayzh (P_ ba, W_ of, W_ sz, W_ e) 
    integer_cmm_importIntegerFromByteArrayzh (P_ ba, W_ of, W_ sz, W_ e) 
    90158  W_ mp_result; 
    91159 
    92160again: 
    93   STK_CHK_GEN_N (SIZEOF_MP_INT); 
     161  STK_CHK_GEN_N (SIZEOF_MP_INT_1LIMB); 
    94162  MAYBE_GC(again); 
    95163 
    96   mp_result = Sp - SIZEOF_MP_INT; 
     164  mp_result = Sp - SIZEOF_MP_INT_1LIMB; 
     165  MP_INT_1LIMB_INIT0(mp_result); 
    97166 
    98167  src_ptr = BYTE_ARR_CTS(ba) + of; 
    99168 
    100   ccall __gmpz_init(mp_result "ptr"); 
    101169  ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr"); 
    102170 
    103   return(MP_INT_AS_PAIR(mp_result)); 
     171  MP_INT_1LIMB_RETURN(mp_result); 
    104172} 
    105173 
    106174/* :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Int#, ByteArray# #) */ 
    again: 
    112180  STK_CHK_GEN_N (SIZEOF_MP_INT); 
    113181  MAYBE_GC(again); 
    114182 
    115   mp_result = Sp - SIZEOF_MP_INT; 
     183  mp_result = Sp - SIZEOF_MP_INT_1LIMB; 
     184 
     185  MP_INT_1LIMB_INIT0(mp_result); 
    116186 
    117   ccall __gmpz_init(mp_result "ptr"); 
    118187  ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr"); 
    119188 
    120   return(MP_INT_AS_PAIR(mp_result)); 
     189  MP_INT_1LIMB_RETURN(mp_result); 
    121190} 
    122191 
    123192/* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */ 
    name (W_ ws1, P_ d1, W_ ws2, P_ d2) \ 
    326395  W_ mp_result1;                                                \ 
    327396                                                                \ 
    328397again:                                                          \ 
    329   STK_CHK_GEN_N (3 * SIZEOF_MP_INT);                            \ 
     398  STK_CHK_GEN_N (2*SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);        \ 
    330399  MAYBE_GC(again);                                              \ 
    331400                                                                \ 
    332   mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                          \ 
    333   mp_tmp2    = Sp - 2 * SIZEOF_MP_INT;                          \ 
    334   mp_result1 = Sp - 3 * SIZEOF_MP_INT;                          \ 
     401  mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                            \ 
     402  mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                            \ 
     403  mp_result1 = Sp - 2*SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;      \ 
    335404                                                                \ 
    336405  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \ 
    337406  MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                           \ 
    338407                                                                \ 
    339   ccall __gmpz_init(mp_result1 "ptr");                          \ 
     408  MP_INT_1LIMB_INIT0(mp_result1);                               \ 
    340409                                                                \ 
    341410  /* Perform the operation */                                   \ 
    342411  ccall mp_fun(mp_result1 "ptr",mp_tmp1  "ptr",mp_tmp2  "ptr"); \ 
    343412                                                                \ 
    344   return (MP_INT_AS_PAIR(mp_result1));                          \ 
     413  MP_INT_1LIMB_RETURN(mp_result1);                              \ 
    345414} 
    346415 
    347416#define GMP_TAKE3_RET1(name,mp_fun)                             \ 
    name (W_ ws1, P_ d1, W_ ws2, P_ d2, W_ ws3, P_ d3) \ 
    353422  W_ mp_result1;                                                \ 
    354423                                                                \ 
    355424again:                                                          \ 
    356   STK_CHK_GEN_N (4 * SIZEOF_MP_INT);                            \ 
     425  STK_CHK_GEN_N (3*SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);        \ 
    357426  MAYBE_GC(again);                                              \ 
    358427                                                                \ 
    359   mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                          \ 
    360   mp_tmp2    = Sp - 2 * SIZEOF_MP_INT;                          \ 
    361   mp_tmp3    = Sp - 3 * SIZEOF_MP_INT;                          \ 
    362   mp_result1 = Sp - 4 * SIZEOF_MP_INT;                          \ 
     428  mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                            \ 
     429  mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                            \ 
     430  mp_tmp3    = Sp - 3*SIZEOF_MP_INT;                            \ 
     431  mp_result1 = Sp - 3*SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;      \ 
    363432                                                                \ 
    364433  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \ 
    365434  MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                           \ 
    366435  MP_INT_SET_FROM_BA(mp_tmp3,ws3,d3);                           \ 
    367436                                                                \ 
    368   ccall __gmpz_init(mp_result1 "ptr");                          \ 
     437  MP_INT_1LIMB_INIT0(mp_result1);                               \ 
    369438                                                                \ 
    370439  /* Perform the operation */                                   \ 
    371   ccall mp_fun(mp_result1 "ptr",mp_tmp1  "ptr",mp_tmp2  "ptr",  \ 
    372                mp_tmp3  "ptr");                                 \ 
     440  ccall mp_fun(mp_result1 "ptr",                                \ 
     441               mp_tmp1 "ptr", mp_tmp2 "ptr", mp_tmp3 "ptr");    \ 
    373442                                                                \ 
    374   return (MP_INT_AS_PAIR(mp_result1));                          \ 
     443  MP_INT_1LIMB_RETURN(mp_result1);                              \ 
    375444} 
    376445 
    377446#define GMP_TAKE1_UL1_RET1(name,mp_fun)                         \ 
    name (W_ ws1, P_ d1, W_ wul) \ 
    382451                                                                \ 
    383452  /* call doYouWantToGC() */                                    \ 
    384453again:                                                          \ 
    385   STK_CHK_GEN_N (2 * SIZEOF_MP_INT);                            \ 
     454  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);          \ 
    386455  MAYBE_GC(again);                                              \ 
    387456                                                                \ 
    388   mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                          \ 
    389   mp_result  = Sp - 2 * SIZEOF_MP_INT;                          \ 
     457  mp_tmp     = Sp - SIZEOF_MP_INT;                              \ 
     458  mp_result  = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;        \ 
    390459                                                                \ 
    391460  MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                            \ 
    392461                                                                \ 
    393   ccall __gmpz_init(mp_result "ptr");                           \ 
     462  MP_INT_1LIMB_INIT0(mp_result);                                \ 
    394463                                                                \ 
    395464  /* Perform the operation */                                   \ 
    396465  ccall mp_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(wul));  \ 
    397466                                                                \ 
    398   return (MP_INT_AS_PAIR(mp_result));                           \ 
     467  MP_INT_1LIMB_RETURN(mp_result);                               \ 
    399468} 
    400469 
    401470#define GMP_TAKE1_I1_RETI1(name,mp_fun)                         \ 
    name (W_ ws1, P_ d1) \ 
    443512  W_ mp_result1;                                                \ 
    444513                                                                \ 
    445514again:                                                          \ 
    446   STK_CHK_GEN_N (2 * SIZEOF_MP_INT);                            \ 
     515  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);          \ 
    447516  MAYBE_GC(again);                                              \ 
    448517                                                                \ 
    449   mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                          \ 
    450   mp_result1 = Sp - 2 * SIZEOF_MP_INT;                          \ 
     518  mp_tmp1    = Sp - SIZEOF_MP_INT;                              \ 
     519  mp_result1 = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;        \ 
    451520                                                                \ 
    452521  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                           \ 
    453522                                                                \ 
    454   ccall __gmpz_init(mp_result1 "ptr");                          \ 
     523  MP_INT_1LIMB_INIT0(mp_result1);                               \ 
    455524                                                                \ 
    456525  /* Perform the operation */                                   \ 
    457526  ccall mp_fun(mp_result1 "ptr",mp_tmp1 "ptr");                 \ 
    458527                                                                \ 
    459   return(MP_INT_AS_PAIR(mp_result1));                           \ 
     528  MP_INT_1LIMB_RETURN(mp_result1);                              \ 
    460529} 
    461530 
    462531#define GMP_TAKE2_RET2(name,mp_fun)                                     \ 
    name (W_ ws1, P_ d1, W_ ws2, P_ d2) \ 
    468537  W_ mp_result2;                                                        \ 
    469538                                                                        \ 
    470539again:                                                                  \ 
    471   STK_CHK_GEN_N (4 * SIZEOF_MP_INT);                                    \ 
     540  STK_CHK_GEN_N (2*SIZEOF_MP_INT + 2*SIZEOF_MP_INT_1LIMB);              \ 
    472541  MAYBE_GC(again);                                                      \ 
    473542                                                                        \ 
    474   mp_tmp1    = Sp - 1 * SIZEOF_MP_INT;                                  \ 
    475   mp_tmp2    = Sp - 2 * SIZEOF_MP_INT;                                  \ 
    476   mp_result1 = Sp - 3 * SIZEOF_MP_INT;                                  \ 
    477   mp_result2 = Sp - 4 * SIZEOF_MP_INT;                                  \ 
     543  mp_tmp1    = Sp - 1*SIZEOF_MP_INT;                                    \ 
     544  mp_tmp2    = Sp - 2*SIZEOF_MP_INT;                                    \ 
     545  mp_result1 = Sp - 2*SIZEOF_MP_INT - 1*SIZEOF_MP_INT_1LIMB;            \ 
     546  mp_result2 = Sp - 2*SIZEOF_MP_INT - 2*SIZEOF_MP_INT_1LIMB;            \ 
    478547                                                                        \ 
    479548  MP_INT_SET_FROM_BA(mp_tmp1,ws1,d1);                                   \ 
    480549  MP_INT_SET_FROM_BA(mp_tmp2,ws2,d2);                                   \ 
    481550                                                                        \ 
    482   ccall __gmpz_init(mp_result1 "ptr");                                  \ 
    483   ccall __gmpz_init(mp_result2 "ptr");                                  \ 
     551  MP_INT_1LIMB_INIT0(mp_result1);                                       \ 
     552  MP_INT_1LIMB_INIT0(mp_result2);                                       \ 
    484553                                                                        \ 
    485554  /* Perform the operation */                                           \ 
    486   ccall mp_fun(mp_result1 "ptr",mp_result2 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr"); \ 
     555  ccall mp_fun(mp_result1 "ptr", mp_result2 "ptr",                      \ 
     556               mp_tmp1 "ptr", mp_tmp2 "ptr");                           \ 
    487557                                                                        \ 
    488   return (MP_INT_AS_PAIR(mp_result1),MP_INT_AS_PAIR(mp_result2));       \ 
     558  MP_INT_1LIMB_RETURN2(mp_result1, mp_result2);                         \ 
    489559} 
    490560 
    491561GMP_TAKE2_RET1(integer_cmm_plusIntegerzh,           __gmpz_add) 
    name(W_ ws1, P_ d1, W_ wl) \ 
    657727  W_ mp_result;                                                         \ 
    658728                                                                        \ 
    659729again:                                                                  \ 
    660   STK_CHK_GEN_N (2 * SIZEOF_MP_INT);                                    \ 
     730  STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_MP_INT_1LIMB);                  \ 
    661731  MAYBE_GC(again);                                                      \ 
    662732                                                                        \ 
    663   mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                                  \ 
    664   mp_result  = Sp - 2 * SIZEOF_MP_INT;                                  \ 
     733  mp_tmp     = Sp - SIZEOF_MP_INT;                                      \ 
     734  mp_result  = Sp - SIZEOF_MP_INT - SIZEOF_MP_INT_1LIMB;                \ 
    665735                                                                        \ 
    666736  MP_INT_SET_FROM_BA(mp_tmp,ws1,d1);                                    \ 
    667737                                                                        \ 
    668   ccall __gmpz_init(mp_result "ptr");                                   \ 
     738  MP_INT_1LIMB_INIT0(mp_result);                                        \ 
    669739                                                                        \ 
    670740  if(%lt(wl,0)) {                                                       \ 
    671741      ccall neg_arg_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(-wl)); \ 
    672       return(MP_INT_AS_PAIR(mp_result));                                \ 
     742  } else {                                                              \ 
     743      ccall pos_arg_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(wl));  \ 
    673744  }                                                                     \ 
    674745                                                                        \ 
    675   ccall pos_arg_fun(mp_result "ptr", mp_tmp "ptr", W_TO_LONG(wl));      \ 
    676   return(MP_INT_AS_PAIR(mp_result));                                    \ 
     746  MP_INT_1LIMB_RETURN(mp_result);                                       \ 
    677747} 
    678748 
    679749/* NB: We need both primitives as we can't express 'minusIntegerInt#'