[Git][ghc/ghc][wip/js-staging] 2 commits: Primop: fix quotRem2Word32
Sylvain Henry (@hsyl20)
gitlab at gitlab.haskell.org
Tue Aug 16 15:52:14 UTC 2022
Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
195ef078 by Sylvain Henry at 2022-08-16T17:27:52+02:00
Primop: fix quotRem2Word32
- - - - -
e27e532f by Sylvain Henry at 2022-08-16T17:54:39+02:00
Primop: fix timesInt2. Progress towards passing arith003
- - - - -
1 changed file:
- js/arith.js.pp
Changes:
=====================================
js/arith.js.pp
=====================================
@@ -386,47 +386,42 @@ var h$mulInt32 = Math.imul ? Math.imul : h$imul_shim;
// Compute product of two Ints. Returns (nh,ch,cl)
// where (ch,cl) are the two parts of the 64-bit result
// and nh is 0 if ch can be safely dropped (i.e. it's a sign-extension of cl).
-function h$hs_timesInt2(l1,l2) {
- TRACE_ARITH("timesInt2 " + l1 + " " + l2);
+function h$hs_timesInt2(a,b) {
+ TRACE_ARITH("timesInt2 " + a + " " + b);
+
+ // adapted from Hacker's Delight (p174)
// check for 0 and 1 operands
- if (l1 === 0) {
+ if (a === 0) {
RETURN_UBX_TUP3(0,0,0);
}
- if (l2 === 0) {
+ if (b === 0) {
RETURN_UBX_TUP3(0,0,0);
}
- if (l1 === 1) {
- RETURN_UBX_TUP3(0,l2<0?(-1):0,l2);
+ if (a === 1) {
+ RETURN_UBX_TUP3(0,b<0?(-1):0,b);
}
- if (l2 === 1) {
- RETURN_UBX_TUP3(0,l1<0?(-1):0,l1);
+ if (b === 1) {
+ RETURN_UBX_TUP3(0,a<0?(-1):0,a);
}
- var a16 = l1 >>> 16;
- var a00 = l1 & 0xFFFF;
+ var cl = (a * b)|0;
- var b16 = l2 >>> 16;
- var b00 = l2 & 0xFFFF;
+ var ha = a >> 16;
+ var la = a & 0xFFFF;
- var c48 = 0, c32 = 0, c16 = 0, c00 = 0;
- c00 += a00 * b00;
- c16 += c00 >>> 16;
- c00 &= 0xFFFF;
- c16 += a16 * b00;
- c32 += c16 >>> 16;
- c16 &= 0xFFFF;
- c16 += a00 * b16;
- c32 += c16 >>> 16;
- c16 &= 0xFFFF;
- c32 &= 0xFFFF;
- c32 += a16 * b16;
- c48 += c32 >>> 16;
- c32 &= 0xFFFF;
- c48 &= 0xFFFF;
- var ch = (c48 << 16) | c32
- var cl = (c16 << 16) | c00
+ var hb = b >> 16;
+ var lb = b & 0xFFFF;
+
+ var w0 = (la*lb)|0;
+ var t = ((ha*lb)|0 + (w0 >> 16))|0;
+ var w1 = t & 0xFFFF;
+ var w2 = t >> 16;
+ w1 = ((la*hb)|0 + w1)|0;
+
+ var ch = (ha*hb + w2 + w1 >> 16)|0;
var nh = ((ch === 0 && cl >= 0) || (ch === -1 && cl < 0)) ? 0 : 1
+
TRACE_ARITH("timesInt2 results:" + nh + " " + ch + " " + cl);
RETURN_UBX_TUP3(nh, ch, cl);
}
@@ -536,9 +531,14 @@ function h$quotRemWord32(n,d) {
var t = d >> 31;
var n2 = n & ~t;
var q = ((n2 >>> 1) / d) << 1;
- var r = (n - q * d) >>> 0;
- var c = (r >>> 0) >= (d >>> 0);
- RETURN_UBX_TUP2((q + (c ? 1 : 0)) >>> 0, (r - (c ? d : 0)) >>> 0);
+ var r = UN(n - q * d);
+ var c = UN(r) >= UN(d);
+ var rq = UN(q + (c ? 1 : 0));
+ var rr = UN(r - (c ? d : 0));
+
+ TRACE_ARITH("quotRemWord32 results: " + rq + " " + rr);
+
+ RETURN_UBX_TUP2(rq,rr);
}
function h$quotRem2Word32(nh,nl,d) {
@@ -561,39 +561,56 @@ function h$quotRem2Word32(nh,nl,d) {
}
var s = Math.clz32(d); // 0 <= s <= 31
- d = d << s; // normalize divisor
+ d = UN(d << s); // normalize divisor
var dh = d >>> 16; // break divisor up into two 16-bit digits
var dl = d & 0xFFFF;
+ TRACE_ARITH("quotRem2Word32 s " + s);
+ TRACE_ARITH("quotRem2Word32 normalized d " + d + " " + dh + " " + dl);
+
// shift dividend left too
- var un32 = UN((nh << s) | ((nl >>> (32-s)) & (-s >> 31)));
+ var un32 = UN((nh << s) | ((nl >>> (32-s)) & ((-s) >> 31)));
var un10 = UN(nl << s);
var un1 = un10 >>> 16; // break lower part of the divisor into two 16-bit digits
var un0 = un10 & 0xFFFF;
+ TRACE_ARITH("quotRem2Word32 uns " + un32 + " " + un10 + " " + un1 + " " + un0);
+
var q1 = UN(un32 / dh); // compute first quotient digit q1
var rhat = UN(un32 - UN(q1*dh));
- while (q1 >= 0xFFFF || UN(q1*dl) > UN(UN(rhat << 16) + un1)) {
+ TRACE_ARITH("quotRem2Word32 q1 rhat " + q1 + " " + rhat);
+
+ while (q1 > 0xFFFF || UN(q1*dl) > (UN(UN(rhat << 16) | un1))) {
q1 = UN(q1 - 1);
rhat = UN(rhat + dh);
- if (rhat >= 0xFFFF) break;
+ if (rhat > 0xFFFF) break;
}
- var un21 = UN(UN(UN(un32 << 16) + un1) - UN(q1*d));
+ TRACE_ARITH("quotRem2Word32 q1' rhat' " + q1 + " " + rhat);
+
+ var un21 = UN(UN(UN(un32 << 16) | un1) - UN(q1*d));
+
+ TRACE_ARITH("quotRem2Word32 un21 " + un21);
var q0 = UN(un21 / dh); // compute second quotient digit q0
rhat = UN(un21 - UN(q0*dh));
- while (q0 >= 0xFFFF || UN(q0*dh) > UN(UN(rhat << 16) + un0)) {
+ TRACE_ARITH("quotRem2Word32 q0 rhat " + q0 + " " + rhat);
+
+ while (q0 > 0xFFFF || UN(q0*dl) > UN(UN(rhat << 16) + un0)) {
q0 = UN(q0 - 1);
rhat = UN(rhat + dh);
- if (rhat >= 0xFFFF) break;
+ if (rhat > 0xFFFF) break;
}
- var rq = UN(q1 << 16 + q0);
- var rr = (UN(un21 << 16) + un0 - UN(q0*d)) >>> s;
+ TRACE_ARITH("quotRem2Word32 q0' rhat' " + q0 + " " + rhat);
+
+ var rq = UN(q1 << 16 | q0);
+ var rr = (UN(UN(un21 << 16) | un0) - UN(q0*d)) >>> s;
+
+ TRACE_ARITH("quotRem2Word32 results: " + rq + " " + rr);
RETURN_UBX_TUP2(rq,rr);
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12d3c118933a9c05eb122d8fa51532e02d17d518...e27e532fee0dcb2629f057169d392e9dd6dbcbd9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12d3c118933a9c05eb122d8fa51532e02d17d518...e27e532fee0dcb2629f057169d392e9dd6dbcbd9
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220816/69553c62/attachment-0001.html>
More information about the ghc-commits
mailing list