[Git][ghc/ghc][wip/js-staging] 2 commits: PrimOp: fix timesInt32
Sylvain Henry (@hsyl20)
gitlab at gitlab.haskell.org
Wed Aug 17 13:49:19 UTC 2022
Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
030bd453 by Sylvain Henry at 2022-08-17T12:00:54+02:00
PrimOp: fix timesInt32
- - - - -
4382f3e2 by Sylvain Henry at 2022-08-17T15:52:04+02:00
PrimOp: use mulWord32 when appropriate
- - - - -
2 changed files:
- compiler/GHC/StgToJS/Prim.hs
- js/arith.js.pp
Changes:
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -62,7 +62,6 @@ genPrim prof ty op = case op of
IntSubOp -> \[r] [x,y] -> PrimInline $ r |= trunc (Sub x y)
IntMulOp -> \[r] [x,y] -> PrimInline $ r |= app "h$mulInt32" [x, y]
IntMul2Op -> \[c,hr,lr] [x,y] -> PrimInline $ appT [c,hr,lr] "h$hs_timesInt2" [x, y]
--- fixme may will give the wrong result in case of overflow
IntMulMayOfloOp -> \[r] [x,y] -> PrimInline $ jVar \tmp -> mconcat
[ tmp |= Mul x y
, r |= if01 (tmp .===. trunc tmp)
@@ -288,7 +287,7 @@ genPrim prof ty op = case op of
Int64ToWord64Op -> \[r1,r2] [x1,x2] ->
PrimInline $ mconcat
- [ r1 |= x1
+ [ r1 |= x1 .>>>. 0
, r2 |= x2
]
IntToInt64Op -> \[r1,r2] [x] ->
=====================================
js/arith.js.pp
=====================================
@@ -405,7 +405,7 @@ function h$hs_timesInt2(a,b) {
RETURN_UBX_TUP3(0,a<0?(-1):0,a);
}
- var cl = (a * b)|0;
+ var cl = h$mulInt32(a,b);
var ha = a >> 16;
var la = a & 0xFFFF;
@@ -413,13 +413,13 @@ function h$hs_timesInt2(a,b) {
var hb = b >> 16;
var lb = b & 0xFFFF;
- var w0 = (la*lb)|0;
- var t = ((ha*lb)|0 + (w0 >> 16))|0;
+ var w0 = la * lb;
+ var t = (h$mulInt32(ha,lb) + (w0 >>> 16))|0;
var w1 = t & 0xFFFF;
var w2 = t >> 16;
- w1 = ((la*hb)|0 + w1)|0;
+ w1 = (h$mulInt32(la,hb) + w1)|0;
- var ch = (ha*hb + w2 + w1 >> 16)|0;
+ var ch = ((h$mulInt32(ha,hb) + w2)|0 + (w1 >> 16))|0;
var nh = ((ch === 0 && cl >= 0) || (ch === -1 && cl < 0)) ? 0 : 1
TRACE_ARITH("timesInt2 results:" + nh + " " + ch + " " + cl);
@@ -498,7 +498,7 @@ function h$mul2Word32(l1,l2) {
c48 += c32 >>> 16;
c32 &= 0xFFFF;
c48 &= 0xFFFF;
- RETURN_UBX_TUP2((c48 << 16) | c32, (c16 << 16) | c00);
+ RETURN_UBX_TUP2(UN((c48 << 16) | c32), UN((c16 << 16) | c00));
}
function h$quotWord32(n,d) {
@@ -509,8 +509,8 @@ function h$quotWord32(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);
+ var r = (n - h$mulWord32(q,d)) >>> 0;
+ var c = UN(r) >= UN(d);
return (q + (c ? 1 : 0)) >>> 0;
}
@@ -520,9 +520,9 @@ function h$remWord32(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 (r - (c ? d : 0)) >>> 0;
+ var r = (n - h$mulWord32(q,d)) >>> 0;
+ var c = UN(r) >= UN(d);
+ return UN(r - (c ? d : 0));
}
function h$quotRemWord32(n,d) {
@@ -531,7 +531,7 @@ function h$quotRemWord32(n,d) {
var t = d >> 31;
var n2 = n & ~t;
var q = ((n2 >>> 1) / d) << 1;
- var r = UN(n - q * d);
+ var r = UN(n - h$mulWord32(q,d));
var c = UN(r) >= UN(d);
var rq = UN(q + (c ? 1 : 0));
var rr = UN(r - (c ? d : 0));
@@ -544,6 +544,10 @@ function h$quotRemWord32(n,d) {
function h$quotRem2Word32(nh,nl,d) {
TRACE_ARITH("quotRem2Word32 " + nh + " " + nl + " " + d);
+ if (nh === 0) {
+ return h$quotRemWord32(nl,d);
+ }
+
// from Hacker's Delight book (p196)
nh = UN(nh);
@@ -565,8 +569,8 @@ function h$quotRem2Word32(nh,nl,d) {
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);
+ //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)));
@@ -575,29 +579,29 @@ function h$quotRem2Word32(nh,nl,d) {
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);
+ //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));
+ var rhat = UN(un32 - h$mulWord32(q1,dh));
- TRACE_ARITH("quotRem2Word32 q1 rhat " + q1 + " " + rhat);
+ //TRACE_ARITH("quotRem2Word32 q1 rhat " + q1 + " " + rhat);
- while (q1 > 0xFFFF || UN(q1*dl) > (UN(UN(rhat << 16) | un1))) {
+ while (q1 > 0xFFFF || h$mulWord32(q1,dl) > (UN(UN(rhat << 16) | un1))) {
q1 = UN(q1 - 1);
rhat = UN(rhat + dh);
if (rhat > 0xFFFF) break;
}
- TRACE_ARITH("quotRem2Word32 q1' rhat' " + q1 + " " + rhat);
+ //TRACE_ARITH("quotRem2Word32 q1' rhat' " + q1 + " " + rhat);
var un21 = UN(UN(UN(un32 << 16) | un1) - UN(q1*d));
- TRACE_ARITH("quotRem2Word32 un21 " + un21);
+ //TRACE_ARITH("quotRem2Word32 un21 " + un21);
var q0 = UN(un21 / dh); // compute second quotient digit q0
- rhat = UN(un21 - UN(q0*dh));
+ rhat = UN(un21 - h$mulWord32(q0,dh));
- TRACE_ARITH("quotRem2Word32 q0 rhat " + q0 + " " + rhat);
+ //TRACE_ARITH("quotRem2Word32 q0 rhat " + q0 + " " + rhat);
while (q0 > 0xFFFF || UN(q0*dl) > UN(UN(rhat << 16) + un0)) {
q0 = UN(q0 - 1);
@@ -605,10 +609,10 @@ function h$quotRem2Word32(nh,nl,d) {
if (rhat > 0xFFFF) break;
}
- TRACE_ARITH("quotRem2Word32 q0' rhat' " + q0 + " " + rhat);
+ //TRACE_ARITH("quotRem2Word32 q0' rhat' " + q0 + " " + rhat);
var rq = UN(q1 << 16 | q0);
- var rr = (UN(UN(un21 << 16) | un0) - UN(q0*d)) >>> s;
+ var rr = (UN(UN(un21 << 16) | un0) - h$mulWord32(q0,d)) >>> s;
TRACE_ARITH("quotRem2Word32 results: " + rq + " " + rr);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bbb6b10e7c51c4114f73f078935001106a18e1e...4382f3e2c8ad443dc703411b6bc0e3c98e62487a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bbb6b10e7c51c4114f73f078935001106a18e1e...4382f3e2c8ad443dc703411b6bc0e3c98e62487a
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/20220817/f10bd3fd/attachment-0001.html>
More information about the ghc-commits
mailing list