Commit 06b9561a authored by Daishi Nakajima's avatar Daishi Nakajima Committed by Ben Gamari
Browse files

Fix the right-shift operation for negative big integers (fixes #12136)

In `x shiftR y`, any of the following conditions cause an abort:
- `x` is a negative big integer
- The size of `x` and `y` is a multiple of `GMP_NUMB_BITS`
- The bit of the absolute value of `x` is filled with `1`

For example:
Assuming `GMP_NUMB_BITS = 2`,  the processing of `-15 shiftR 2` is as 
follows:

1. -15 = -1111 (twos complement: 10001)
2. right shift 2 (as a positive number) -> 0011
3. Due to the shift larger than GMP_NUMB_BITS, the size of the 
destination is decreasing (2bit) -> 11
4. Add 1, and get carry: (1) 00
5. abort

I fixed it that the destination size does not decrease in such a case.

Test Plan: I tested the specific case being reported.

Reviewers: goldfire, austin, hvr, bgamari, rwbarton

Reviewed By: bgamari, rwbarton

Subscribers: mpickering, rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D2998

GHC Trac Issues: #12136
parent 2ffcdfad
......@@ -105,7 +105,10 @@ integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[], mp_size_t sn,
/* Twos-complement version of 'integer_gmp_mpn_rshift' for performing
* arithmetic right shifts on "negative" MPNs.
*
* Same pre-conditions as 'integer_gmp_mpn_rshift'
* pre-conditions:
* - 0 < count < sn*GMP_NUMB_BITS
* - rn = sn - floor((count - 1) / GMP_NUMB_BITS)
* - sn > 0
*
* This variant is needed to operate on MPNs interpreted as negative
* numbers, which require "rounding" towards minus infinity iff a
......@@ -117,7 +120,7 @@ integer_gmp_mpn_rshift_2c (mp_limb_t rp[], const mp_limb_t sp[],
{
const mp_size_t limb_shift = count / GMP_NUMB_BITS;
const unsigned int bit_shift = count % GMP_NUMB_BITS;
const mp_size_t rn = sn - limb_shift;
mp_size_t rn = sn - limb_shift;
// whether non-zero bits were shifted out
bool nz_shift_out = false;
......@@ -125,8 +128,13 @@ integer_gmp_mpn_rshift_2c (mp_limb_t rp[], const mp_limb_t sp[],
if (bit_shift) {
if (mpn_rshift(rp, &sp[limb_shift], rn, bit_shift))
nz_shift_out = true;
} else
} else {
// rp was allocated (rn + 1) limbs, to prevent carry
// on mpn_add_1 when all the bits of {rp, rn} are 1.
memset(&rp[rn], 0, sizeof(mp_limb_t));
memcpy(rp, &sp[limb_shift], rn*sizeof(mp_limb_t));
rn++;
}
if (!nz_shift_out)
for (unsigned i = 0; i < limb_shift; i++)
......
......@@ -1142,7 +1142,7 @@ shiftRNegBigNat x@(BN# xba#) n#
where
xn# = sizeofBigNat# x
yn# = xn# -# nlimbs#
nlimbs# = quotInt# n# GMP_LIMB_BITS#
nlimbs# = quotInt# (n# -# 1#) GMP_LIMB_BITS#
orBigNat :: BigNat -> BigNat -> BigNat
......
{-# LANGUAGE CPP #-}
#include "MachDeps.h"
module Main where
import Data.Bits
#if WORD_SIZE_IN_BITS != 64 && WORD_SIZE_IN_BITS != 32
# error unsupported WORD_SIZE_IN_BITS config
#endif
-- a negative integer the size of GMP_LIMB_BITS*2
negativeBigInteger :: Integer
negativeBigInteger = 1 - (1 `shiftL` (64 * 2))
main = do
-- rigt shift by GMP_LIMB_BITS
print $ negativeBigInteger `shiftR` 64
......@@ -60,3 +60,4 @@ test('T9810', normal, compile_and_run, [''])
test('T10011', normal, compile_and_run, [''])
test('T10962', omit_ways(['ghci']), compile_and_run, [''])
test('T11702', extra_ways(['optasm']), compile_and_run, [''])
test('T12136', normal, compile_and_run, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment