Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • rts/js/arith.js
    ... ... @@ -9,17 +9,8 @@ function h$logArith() { h$log.apply(h$log,arguments); }
    9 9 
     #endif
    10 10
    11 11 
     #define UN(x) ((x)>>>0)
    12 
    -#define W32(x) (BigInt(x))
    13 
    -#define I32(x) (BigInt(x))
    14 12 
     #define W64(h,l) ((BigInt(h) << BigInt(32)) | BigInt(l>>>0))
    15 
    -#define W64h(x) (Number(x >> BigInt(32)) >>> 0)
    16 
    -#define W64l(x) (Number(BigInt.asUintN(32, x)) >>> 0)
    17 13 
     #define I64(h,l) ((BigInt(h) << BigInt(32)) | BigInt(l>>>0))
    18 
    -#define I64h(x) (Number(x >> BigInt(32))|0)
    19 
    -#define I64l(x) (Number(BigInt.asUintN(32,x)) >>> 0)
    20 
    -#define RETURN_I64(x) RETURN_UBX_TUP2(I64h(x), I64l(x))
    21 
    -#define RETURN_W64(x) RETURN_UBX_TUP2(W64h(x), W64l(x))
    22 
    -#define RETURN_W32(x) return Number(x)
    23 14
    24 15
    25 16 
     // N.B. 64-bit numbers are represented by two JS numbers,
    ... ... @@ -27,20 +18,88 @@ function h$logArith() { h$log.apply(h$log,arguments); }
    27 18 
     // See Note [StgToJS design] in GHC.StgToJS for details on
    28 19 
     // number representation.
    29 20
    21 
    +// Internal helper: unsigned 64-bit division and remainder.
    22 
    +// Inputs ah,al,bh,bl are all unsigned 32-bit.
    23 
    +// Returns qh; sets h$ret1=ql, h$ret2=rh, h$ret3=rl.
    24 
    +function h$quotRemWord64(ah, al, bh, bl) {
    25 
    +  // Re-apply >>>0 to make Uint32 types explicit for JIT optimisation,
    26 
    +  // rather than relying on callers to have done so.
    27 
    +  ah >>>= 0; al >>>= 0; bh >>>= 0; bl >>>= 0;
    28 
    +  if (bh === 0 && bl === 0) throw new Error("divide by zero");
    29 
    +  var qh, ql, rh, rl;
    30 
    +  if (bh === 0) {
    31 
    +    // 32-bit divisor: long division in base 2^16
    32 
    +    qh   = Math.floor(ah / bl) >>> 0;
    33 
    +    var r0   = ah - qh * bl;
    34 
    +    var a1   = r0 * 65536 + (al >>> 16);
    35 
    +    var q1   = Math.floor(a1 / bl);
    36 
    +    var r1   = a1 - q1 * bl;
    37 
    +    var a2   = r1 * 65536 + (al & 0xFFFF);
    38 
    +    var q2   = Math.floor(a2 / bl);
    39 
    +    ql  = (q1 * 65536 + q2) >>> 0;
    40 
    +    rl  = (a2 - q2 * bl) >>> 0;
    41 
    +    rh  = 0;
    42 
    +  } else {
    43 
    +    // 64-bit divisor >= 2^32: quotient fits in 32 bits
    44 
    +    qh = 0;
    45 
    +    // Float approximation; error < 1 since q < 2^32 and relative fp error < 2^-52
    46 
    +    var ql_f = Math.floor((ah * 4294967296 + al) / (bh * 4294967296 + bl));
    47 
    +    if (ql_f > 4294967295) ql_f = 4294967295;
    48 
    +    ql = ql_f >>> 0;
    49 
    +    // Compute ql * b exactly once (two 32x32->64-bit products)
    50 
    +    var m1h = h$mul2Word32(ql, bl); var m1l = h$ret1;
    51 
    +    var m2h = h$mul2Word32(ql, bh); var m2l = h$ret1;
    52 
    +    var qbs = m1h + m2l;  // high word sum; may overflow uint32
    53 
    +    var qbh = qbs >>> 0;
    54 
    +    var qbl = m1l;
    55 
    +
    56 
    +    // At most 1 decrease: if ql*b > a, subtract b and decrement ql.
    57 
    +    // Subtracting b from the (possibly truncated) 64-bit product gives
    58 
    +    // exactly (ql-1)*b because (ql-1)*b < 2^64.
    59 
    +    //
    60 
    +    // ql*b is a 96-bit value spread over m2h (bits 95-64), qbh (63-32),
    61 
    +    // qbl (31-0).  The condition has four sub-cases:
    62 
    +    //   m2h > 0          : ql*b >= 2^64 > a  (overflow into bits above 64)
    63 
    +    //   qbs > 4294967295 : m1h+m2l overflows 32 bits, so ql*b >= 2^64 > a
    64 
    +    //                      (qbs is a JS double so the overflow is visible
    65 
    +    //                      before the >>>0 truncation stored in qbh)
    66 
    +    //   qbh > ah         : high words settle it; ql*b > a
    67 
    +    //   qbh === ah && qbl > al : high words tie; low words settle it
    68 
    +    if (m2h > 0 || qbs > 4294967295 || qbh > ah || (qbh === ah && qbl > al)) {
    69 
    +      ql = (ql - 1) >>> 0;
    70 
    +      var dl = qbl - bl; qbl = dl >>> 0;
    71 
    +      qbh = (qbh - bh - (dl !== qbl ? 1 : 0)) >>> 0;
    72 
    +    }
    73 
    +
    74 
    +    // Remainder = a - ql*b
    75 
    +    var drl = al - qbl;
    76 
    +    rl = drl >>> 0;
    77 
    +    rh = (ah - qbh - (drl !== rl ? 1 : 0)) >>> 0;
    78 
    +
    79 
    +    // At most 1 increase: if remainder >= b, subtract b and increment ql.
    80 
    +    if (rh > bh || (rh === bh && rl >= bl)) {
    81 
    +      ql = (ql + 1) >>> 0;
    82 
    +      var drl2 = rl - bl;
    83 
    +      rl  = drl2 >>> 0;
    84 
    +      rh  = (rh - bh - (drl2 !== rl ? 1 : 0)) >>> 0;
    85 
    +    }
    86 
    +  }
    87 
    +  h$ret1 = ql; h$ret2 = rh; h$ret3 = rl;
    88 
    +  return qh;
    89 
    +}
    90 
    +
    30 91 
     function h$hs_quotWord64(h1,l1,h2,l2) {
    31 
    -  var a = W64(h1,l1);
    32 
    -  var b = W64(h2,l2);
    33 
    -  var r = BigInt.asUintN(64, a / b);
    34 
    -  TRACE_ARITH("Word64: " + a + " / " + b + " ==> " + r)
    35 
    -  RETURN_W64(r);
    92 
    +  var qh = h$quotRemWord64(h1>>>0,l1>>>0,h2>>>0,l2>>>0);
    93 
    +  var ql = h$ret1;
    94 
    +  TRACE_ARITH("Word64: " + W64(h1,l1) + " / " + W64(h2,l2) + " ==> " + W64(qh,ql))
    95 
    +  RETURN_UBX_TUP2(qh,ql);
    36 96 
     }
    37 97
    38 98 
     function h$hs_remWord64(h1,l1,h2,l2) {
    39 
    -  var a = W64(h1,l1);
    40 
    -  var b = W64(h2,l2);
    41 
    -  var r = BigInt.asUintN(64, a % b);
    42 
    -  TRACE_ARITH("Word64: " + a + " % " + b + " ==> " + r)
    43 
    -  RETURN_W64(r);
    99 
    +  h$quotRemWord64(h1>>>0,l1>>>0,h2>>>0,l2>>>0);
    100 
    +  var rh = h$ret2, rl = h$ret3;
    101 
    +  TRACE_ARITH("Word64: " + W64(h1,l1) + " % " + W64(h2,l2) + " ==> " + W64(rh,rl))
    102 
    +  RETURN_UBX_TUP2(rh,rl);
    44 103 
     }
    45 104
    46 105 
     function h$hs_timesWord64(h1,l1,h2,l2) {
    ... ... @@ -84,19 +143,55 @@ function h$hs_timesInt64(h1,l1,h2,l2) {
    84 143 
     }
    85 144
    86 145 
     function h$hs_quotInt64(h1,l1,h2,l2) {
    87 
    -  var a = I64(h1,l1);
    88 
    -  var b = I64(h2,l2);
    89 
    -  var r = BigInt.asIntN(64, a / b);
    90 
    -  TRACE_ARITH("Int64: " + a + " / " + b + " ==> " + r)
    91 
    -  RETURN_I64(r);
    146 
    +  // Determine sign: result negative iff operands have different signs
    147 
    +  var neg = (h1 < 0) !== (h2 < 0);
    148 
    +  // Absolute value of (h1,l1)
    149 
    +  var ah, al;
    150 
    +  if (h1 >= 0) { ah = h1 >>> 0; al = l1 >>> 0; }
    151 
    +  else { al = (-l1) >>> 0; ah = (al === 0 ? -h1 : ~h1) >>> 0; }
    152 
    +  // Absolute value of (h2,l2)
    153 
    +  var bh, bl;
    154 
    +  if (h2 >= 0) { bh = h2 >>> 0; bl = l2 >>> 0; }
    155 
    +  else { bl = (-l2) >>> 0; bh = (bl === 0 ? -h2 : ~h2) >>> 0; }
    156 
    +  // Unsigned quotient
    157 
    +  var qh = h$quotRemWord64(ah, al, bh, bl);
    158 
    +  var ql = h$ret1;
    159 
    +  // Apply sign
    160 
    +  if (neg) {
    161 
    +    var nql = (-ql) >>> 0;
    162 
    +    var nqh = (nql === 0 ? -qh : ~qh) | 0;
    163 
    +    TRACE_ARITH("Int64: " + I64(h1,l1) + " / " + I64(h2,l2) + " ==> " + I64(nqh,nql))
    164 
    +    RETURN_UBX_TUP2(nqh, nql);
    165 
    +  } else {
    166 
    +    TRACE_ARITH("Int64: " + I64(h1,l1) + " / " + I64(h2,l2) + " ==> " + I64(qh|0,ql))
    167 
    +    RETURN_UBX_TUP2(qh | 0, ql);
    168 
    +  }
    92 169 
     }
    93 170
    94 171 
     function h$hs_remInt64(h1,l1,h2,l2) {
    95 
    -  var a = I64(h1,l1);
    96 
    -  var b = I64(h2,l2);
    97 
    -  var r = BigInt.asIntN(64, a % b);
    98 
    -  TRACE_ARITH("Int64: " + a + " % " + b + " ==> " + r)
    99 
    -  RETURN_I64(r);
    172 
    +  // Remainder sign follows dividend
    173 
    +  var neg_a = h1 < 0;
    174 
    +  // Absolute value of (h1,l1)
    175 
    +  var ah, al;
    176 
    +  if (h1 >= 0) { ah = h1 >>> 0; al = l1 >>> 0; }
    177 
    +  else { al = (-l1) >>> 0; ah = (al === 0 ? -h1 : ~h1) >>> 0; }
    178 
    +  // Absolute value of (h2,l2)
    179 
    +  var bh, bl;
    180 
    +  if (h2 >= 0) { bh = h2 >>> 0; bl = l2 >>> 0; }
    181 
    +  else { bl = (-l2) >>> 0; bh = (bl === 0 ? -h2 : ~h2) >>> 0; }
    182 
    +  // Unsigned remainder
    183 
    +  h$quotRemWord64(ah, al, bh, bl);
    184 
    +  var rh = h$ret2, rl = h$ret3;
    185 
    +  // Apply sign of dividend
    186 
    +  if (neg_a) {
    187 
    +    var nrl = (-rl) >>> 0;
    188 
    +    var nrh = (nrl === 0 ? -rh : ~rh) | 0;
    189 
    +    TRACE_ARITH("Int64: " + I64(h1,l1) + " % " + I64(h2,l2) + " ==> " + I64(nrh,nrl))
    190 
    +    RETURN_UBX_TUP2(nrh, nrl);
    191 
    +  } else {
    192 
    +    TRACE_ARITH("Int64: " + I64(h1,l1) + " % " + I64(h2,l2) + " ==> " + I64(rh|0,rl))
    193 
    +    RETURN_UBX_TUP2(rh | 0, rl);
    194 
    +  }
    100 195 
     }
    101 196
    102 197 
     function h$hs_plusInt64(h1,l1,h2,l2) {
    ... ... @@ -287,37 +382,44 @@ function h$mul2Word32(l1,l2) {
    287 382 
     }
    288 383
    289 384 
     function h$quotWord32(n,d) {
    290 
    -  var a = W32(n);
    291 
    -  var b = W32(d);
    292 
    -  var r = BigInt.asUintN(32, a / b);
    293 
    -  TRACE_ARITH("Word32: " + a + " / " + b + " ==> " + r)
    294 
    -  RETURN_W32(r);
    385 
    +  if ((d>>>0) === 0) throw new Error("divide by zero");
    386 
    +  var r = Math.floor((n>>>0) / (d>>>0));
    387 
    +  TRACE_ARITH("Word32: " + (n>>>0) + " / " + (d>>>0) + " ==> " + r)
    388 
    +  return r;
    295 389 
     }
    296 390
    297 391 
     function h$remWord32(n,d) {
    298 
    -  var a = W32(n);
    299 
    -  var b = W32(d);
    300 
    -  var r = BigInt.asUintN(32, a % b);
    301 
    -  TRACE_ARITH("Word32: " + a + " % " + b + " ==> " + r)
    302 
    -  RETURN_W32(r);
    392 
    +  if ((d>>>0) === 0) throw new Error("divide by zero");
    393 
    +  var r = (n>>>0) % (d>>>0);
    394 
    +  TRACE_ARITH("Word32: " + (n>>>0) + " % " + (d>>>0) + " ==> " + r)
    395 
    +  return r;
    303 396 
     }
    304 397
    305 398 
     function h$quotRemWord32(n,d) {
    306 
    -  var a = W32(n);
    307 
    -  var b = W32(d);
    308 
    -  var q = BigInt.asUintN(32, a / b);
    309 
    -  var r = BigInt.asUintN(32, a % b);
    310 
    -  TRACE_ARITH("Word32: " + a + " `quotRem` " + b + " ==> (" + q + ", " + r + ")")
    311 
    -  RETURN_UBX_TUP2(Number(q),Number(r));
    399 
    +  var nu = n>>>0, du = d>>>0;
    400 
    +  if (du === 0) throw new Error("divide by zero");
    401 
    +  var q = Math.floor(nu / du);
    402 
    +  var r = nu % du;
    403 
    +  TRACE_ARITH("Word32: " + nu + " `quotRem` " + du + " ==> (" + q + ", " + r + ")")
    404 
    +  RETURN_UBX_TUP2(q, r);
    312 405 
     }
    313 406
    407 
    +// Divide the 64-bit unsigned value (nh*2^32 + nl) by 32-bit unsigned d.
    408 
    +// Precondition: quotient fits in 32 bits (nh < d).
    314 409 
     function h$quotRem2Word32(nh,nl,d) {
    315 
    -  var a = W64(nh,nl);
    316 
    -  var b = W32(d);
    317 
    -  var q = BigInt.asUintN(32, a / b);
    318 
    -  var r = BigInt.asUintN(32, a % b);
    319 
    -  TRACE_ARITH("Word32: " + a + " `quotRem2` " + b + " ==> (" + q + ", " + r + ")")
    320 
    -  RETURN_UBX_TUP2(Number(q),Number(r));
    410 
    +  var dv  = d>>>0;
    411 
    +  if (dv === 0) throw new Error("divide by zero");
    412 
    +  var nh_u = nh>>>0;
    413 
    +  // Long division in base 2^16 (all intermediate values <= 2^48, exact in double)
    414 
    +  var a1  = nh_u * 65536 + ((nl>>>0) >>> 16);
    415 
    +  var q1  = Math.floor(a1 / dv);
    416 
    +  var r1  = a1 - q1 * dv;
    417 
    +  var a2  = r1 * 65536 + ((nl>>>0) & 0xFFFF);
    418 
    +  var q2  = Math.floor(a2 / dv);
    419 
    +  var q   = (q1 * 65536 + q2) >>> 0;
    420 
    +  var r   = (a2 - q2 * dv) >>> 0;
    421 
    +  TRACE_ARITH("Word32: " + W64(nh,nl) + " `quotRem2` " + dv + " ==> (" + q + ", " + r + ")")
    422 
    +  RETURN_UBX_TUP2(q, r);
    321 423 
     }
    322 424
    323 425 
     function h$wordAdd2(l1,l2) {

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help