[Git][ghc/ghc][wip/js-staging] Primop: fix 64-bit shifting primops + add some traces
Sylvain Henry (@hsyl20)
gitlab at gitlab.haskell.org
Tue Aug 16 09:59:24 UTC 2022
Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
12d3c118 by Sylvain Henry at 2022-08-16T12:02:06+02:00
Primop: fix 64-bit shifting primops + add some traces
- - - - -
2 changed files:
- compiler/GHC/StgToJS/Prim.hs
- js/arith.js.pp
Changes:
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -282,10 +282,9 @@ genPrim prof ty op = case op of
Int64QuotOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_quotInt64" [h0,l0,h1,l1]
Int64RemOp -> \[hr,lr] [h0,l0,h1,l1] -> PrimInline $ appT [hr,lr] "h$hs_remInt64" [h0,l0,h1,l1]
- Int64SllOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedIShiftL64" [h,l,n]
- Int64SraOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedIShiftRA64" [h,l,n]
- Int64SrlOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRL64" [h,l,n]
- -- FIXME: Jeff 06-20222: Is this one right? No h$hs_uncheckedIShiftRL64?
+ Int64SllOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftLLInt64" [h,l,n]
+ Int64SraOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRAInt64" [h,l,n]
+ Int64SrlOp -> \[hr,lr] [h,l,n] -> PrimInline $ appT [hr,lr] "h$hs_uncheckedShiftRLInt64" [h,l,n]
Int64ToWord64Op -> \[r1,r2] [x1,x2] ->
PrimInline $ mconcat
@@ -328,9 +327,8 @@ genPrim prof ty op = case op of
Word64LeOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .!==. h1) (l0 .<=. l1)))
Word64LtOp -> \[r] [h0,l0,h1,l1] -> PrimInline $ r |= if10 (LOr (h0 .<. h1) (LAnd (h0 .!==. h1) (l0 .<. l1)))
- Word64SllOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedIShiftL64" [h, l, n]
- Word64SrlOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedShiftRL64" [h, l, n]
- -- FIXME: Jeff 06-20222: Is this one right? No h$hs_uncheckedIShiftRL64?
+ Word64SllOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedShiftLWord64" [h, l, n]
+ Word64SrlOp -> \[hr,hl] [h, l, n] -> PrimInline $ appT [hr, hl] "h$hs_uncheckedShiftRWord64" [h, l, n]
Word64OrOp -> \[hr,hl] [h0, l0, h1, l1] ->
PrimInline $ mconcat
=====================================
js/arith.js.pp
=====================================
@@ -50,6 +50,7 @@ function h$hs_gtInt64(h1,l1,h2,l2) {
}
function h$hs_quotWord64(h1,l1,h2,l2) {
+ TRACE_ARITH("quotWord64: " + h1 + " " + l1 + " " + h2 + " " + l2);
// algorithm adapted from Hacker's Delight p198
// if divisor > numerator, just return 0
@@ -96,6 +97,7 @@ function h$hs_quotWord64(h1,l1,h2,l2) {
}
function h$hs_remWord64(h1,l1,h2,l2) {
+ TRACE_ARITH("remWord64: " + h1 + " " + l1 + " " + h2 + " " + l2);
var qh = h$hs_quotWord64(h1,l1,h2,l2);
var ql = h$ret1;
var qvh = h$hs_timesWord64(h2,l2,qh,ql);
@@ -104,12 +106,14 @@ function h$hs_remWord64(h1,l1,h2,l2) {
}
function h$hs_timesWord64(h1,l1,h2,l2) {
+ TRACE_ARITH("timesWord64: " + h1 + " " + l1 + " " + h2 + " " + l2);
var rl = UN(l1 * l2);
var rh = UN(UN(l2 * h1) + UN(l1 * h2));
RETURN_UBX_TUP2(rh,rl);
}
function h$hs_minusWord64(h1,l1,h2,l2) {
+ TRACE_ARITH("minusWord64: " + h1 + " " + l1 + " " + h2 + " " + l2);
var b = l2 > l1 ? 1 : 0
var rl = UN(l1 - l2);
var rh = UN(UN(h2 - h1) - b);
@@ -117,6 +121,7 @@ function h$hs_minusWord64(h1,l1,h2,l2) {
}
function h$hs_plusWord64(h1,l1,h2,l2) {
+ TRACE_ARITH("plusWord64: " + h1 + " " + l1 + " " + h2 + " " + l2);
var c1 = (l1 & 0x80000000) >>> 31;
var c2 = (l2 & 0x80000000) >>> 31;
var rl = UN(l1 & 0x7FFFFFFF) + UN(l1 & 0x7FFFFFFF);
@@ -129,6 +134,8 @@ function h$hs_plusWord64(h1,l1,h2,l2) {
}
function h$hs_timesInt64(h1,l1,h2,l2) {
+ TRACE_ARITH("timesInt64: " + h1 + " " + l1 + " " + h2 + " " + l2);
+
// check for 0 and 1 operands
if (h1 === 0) {
if (l1 === 0) {
@@ -182,18 +189,24 @@ function h$hs_timesInt64(h1,l1,h2,l2) {
}
function h$hs_quotInt64(h1,l1,h2,l2) {
+ TRACE_ARITH("quotInt64: " + h1 + " " + l1 + " " + h2 + " " + l2);
+
throw "hs_quotInt64 not implemented yet";
//var c = goog.math.Long.fromBits(l1,h1).div(goog.math.Long.fromBits(l2,h2));
//RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits());
}
function h$hs_remInt64(h1,l1,h2,l2) {
+ TRACE_ARITH("remInt64: " + h1 + " " + l1 + " " + h2 + " " + l2);
+
throw "hs_remInt64 not implemented yet";
var c = goog.math.Long.fromBits(l1,h1).modulo(goog.math.Long.fromBits(l2,h2));
RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits());
}
function h$hs_plusInt64(h1,l1,h2,l2) {
+ TRACE_ARITH("plusInt64: " + h1 + " " + l1 + " " + h2 + " " + l2);
+
const a48 = h1 >>> 16;
const a32 = h1 & 0xFFFF;
const a16 = l1 >>> 16;
@@ -220,6 +233,8 @@ function h$hs_plusInt64(h1,l1,h2,l2) {
}
function h$hs_minusInt64(h1,l1,h2,l2) {
+ TRACE_ARITH("minusInt64: " + h1 + " " + l1 + " " + h2 + " " + l2);
+
// negate arg2 and adds it
const nl2 = (~l2 + 1) | 0;
const nh2 = (~h2 + !nl2) | 0;
@@ -227,6 +242,8 @@ function h$hs_minusInt64(h1,l1,h2,l2) {
}
function h$hs_leWord64(h1,l1,h2,l2) {
+ TRACE_ARITH("leWord64: " + h1 + " " + l1 + " " + h2 + " " + l2);
+
if(h1 === h2) {
var l1s = l1 >>> 1;
var l2s = l2 >>> 1;
@@ -239,6 +256,8 @@ function h$hs_leWord64(h1,l1,h2,l2) {
}
function h$hs_ltWord64(h1,l1,h2,l2) {
+ TRACE_ARITH("ltWord64: " + h1 + " " + l1 + " " + h2 + " " + l2);
+
if(h1 === h2) {
var l1s = l1 >>> 1;
var l2s = l2 >>> 1;
@@ -251,6 +270,8 @@ function h$hs_ltWord64(h1,l1,h2,l2) {
}
function h$hs_geWord64(h1,l1,h2,l2) {
+ TRACE_ARITH("geWord64: " + h1 + " " + l1 + " " + h2 + " " + l2);
+
if(h1 === h2) {
var l1s = l1 >>> 1;
var l2s = l2 >>> 1;
@@ -263,6 +284,8 @@ function h$hs_geWord64(h1,l1,h2,l2) {
}
function h$hs_gtWord64(h1,l1,h2,l2) {
+ TRACE_ARITH("gtWord64: " + h1 + " " + l1 + " " + h2 + " " + l2);
+
if(h1 === h2) {
var l1s = l1 >>> 1;
var l2s = l2 >>> 1;
@@ -274,69 +297,76 @@ function h$hs_gtWord64(h1,l1,h2,l2) {
}
}
-function h$hs_remWord64(h1,l1,h2,l2) {
- throw "hs_remWord64 not implemented yet";
- /* var a = h$bigFromWord64(h1,l1);
- var b = h$bigFromWord64(h2,l2);
- var c = a.mod(b); */
- var r = h$ghcjsbn_rem_bb(h$ghcjsbn_mkBigNat_ww(h1,l1)
- ,h$ghcjsbn_mkBigNat_ww(h2,l2));
- return h$ghcjsbn_toWord64_b(r);
- // RETURN_UBX_TUP2(c.shiftRight(32).intValue(), c.intValue());
-}
+function h$hs_uncheckedShiftLWord64(h,l,n) {
+ TRACE_ARITH("uncheckedShiftLWord64: " + h + " " + l + " " + n);
-function h$hs_uncheckedIShiftL64(h,l,n) {
n &= 63;
if (n == 0) {
RETURN_UBX_TUP2(h,l);
+ } else if (n === 32) {
+ RETURN_UBX_TUP2(l,0);
+ } else if (n < 32) {
+ RETURN_UBX_TUP2(UN((h << n) | (l >>> (32 - n))), UN(l << n));
} else {
- if (n < 32) {
- RETURN_UBX_TUP2((h << n) | (l >>> (32 - n)), l << n);
- } else {
- RETURN_UBX_TUP2(l << (n - 32), 0);
- }
+ RETURN_UBX_TUP2(UN(l << (n - 32)), 0);
+ }
+}
+
+function h$hs_uncheckedShiftRWord64(h,l,n) {
+ TRACE_ARITH("uncheckedShiftRWord64 " + h + " " + l + " " + n);
+
+ n &= 63;
+ if(n == 0) {
+ RETURN_UBX_TUP2(h, l);
+ } else if(n === 32) {
+ RETURN_UBX_TUP2(0, h);
+ } else if(n < 32) {
+ RETURN_UBX_TUP2(h >>> n, UN((l >>> n ) | (h << (32-n))));
+ } else {
+ RETURN_UBX_TUP2(0, (h >>> (n-32)));
}
}
-function h$hs_uncheckedIShiftRA64(h,l,n) {
+function h$hs_uncheckedShiftLLInt64(h,l,n) {
+ TRACE_ARITH("uncheckedShiftLLInt64: " + h + " " + l + " " + n);
+
n &= 63;
if (n == 0) {
RETURN_UBX_TUP2(h,l);
+ } else if (n === 32) {
+ RETURN_UBX_TUP2(l|0,0);
+ } else if (n < 32) {
+ RETURN_UBX_TUP2((h << n) | (l >>> (32 - n)), UN(l << n));
} else {
- if (n < 32) {
- RETURN_UBX_TUP2(h >> n, (l >>> n) | (h << (32 - n)));
- } else {
- RETURN_UBX_TUP2(h >= 0 ? 0 : -1, h >> (n - 32));
- }
+ RETURN_UBX_TUP2(l << (n - 32), 0);
}
}
-// always nonnegative n?
-function h$hs_uncheckedShiftL64(h1,l1,n) {
- TRACE_ARITH("hs_uncheckedShiftL64 " + h1 + " " + l1 + " " + n);
+function h$hs_uncheckedShiftRAInt64(h,l,n) {
+ TRACE_ARITH("uncheckedShiftRAInt64: " + h + " " + l + " " + n);
+
n &= 63;
- TRACE_ARITH("hs_uncheckedShiftL64 n " + n);
- if(n == 0) {
- TRACE_ARITH("hs_uncheckedShiftL64 zero");
- RETURN_UBX_TUP2(h1, l1);
- } else if(n < 32) {
- TRACE_ARITH("hs_uncheckedShiftL64 sm32");
- RETURN_UBX_TUP2((h1 << n) | (l1 >>> (32-n)), l1 << n);
+ if (n == 0) {
+ RETURN_UBX_TUP2(h,l);
+ } else if (n < 32) {
+ RETURN_UBX_TUP2(h >> n, UN((l >>> n) | (h << (32 - n))));
} else {
- TRACE_ARITH("hs_uncheckedShiftL64 result " + ((l1 << (n-32))|0) + " " + 0);
- RETURN_UBX_TUP2(((l1 << (n-32))|0), 0);
+ RETURN_UBX_TUP2(h >= 0 ? 0 : -1, UN(h >> (n - 32)));
}
}
-function h$hs_uncheckedShiftRL64(h1,l1,n) {
- TRACE_ARITH("hs_uncheckedShiftRL64 " + h1 + " " + l1 + " " + n);
+function h$hs_uncheckedShiftRLInt64(h,l,n) {
+ TRACE_ARITH("uncheckedShiftRLInt64 " + h + " " + l + " " + n);
+
n &= 63;
if(n == 0) {
- RETURN_UBX_TUP2(h1, l1);
+ RETURN_UBX_TUP2(h, l);
+ } else if(n == 32) {
+ RETURN_UBX_TUP2(0, h);
} else if(n < 32) {
- RETURN_UBX_TUP2(h1 >>> n, (l1 >>> n ) | (h1 << (32-n)));
+ RETURN_UBX_TUP2(h >>> n, UN((l >>> n) | (h << (32-n))));
} else {
- RETURN_UBX_TUP2(0, (h1 >>> (n-32))|0);
+ RETURN_UBX_TUP2(0, (h >>> (n-32)));
}
}
@@ -353,16 +383,12 @@ function h$imul_shim(a, b) {
var h$mulInt32 = Math.imul ? Math.imul : h$imul_shim;
-// function h$mulInt32(a,b) {
-// return goog.math.Long.fromInt(a).multiply(goog.math.Long.fromInt(b)).getLowBits();
-// }
-// var hs_mulInt32 = h$mulInt32;
-
-
// 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);
+
// check for 0 and 1 operands
if (l1 === 0) {
RETURN_UBX_TUP3(0,0,0);
@@ -371,10 +397,10 @@ function h$hs_timesInt2(l1,l2) {
RETURN_UBX_TUP3(0,0,0);
}
if (l1 === 1) {
- RETURN_UBX_TUP3(0,0,l2);
+ RETURN_UBX_TUP3(0,l2<0?(-1):0,l2);
}
if (l2 === 1) {
- RETURN_UBX_TUP3(0,0,l1);
+ RETURN_UBX_TUP3(0,l1<0?(-1):0,l1);
}
var a16 = l1 >>> 16;
@@ -401,11 +427,14 @@ function h$hs_timesInt2(l1,l2) {
var ch = (c48 << 16) | c32
var cl = (c16 << 16) | c00
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);
}
function h$mulWord32(l1,l2) {
+ TRACE_ARITH("mulWord32 " + l1 + " " + l2);
+
// check for 0 and 1 operands
if (l1 === 0) {
return 0;
@@ -438,6 +467,8 @@ function h$mulWord32(l1,l2) {
}
function h$mul2Word32(l1,l2) {
+ TRACE_ARITH("mul2Word32 " + l1 + " " + l2);
+
// check for 0 and 1 operands
if (l1 === 0) {
RETURN_UBX_TUP2(0,0);
@@ -476,6 +507,8 @@ function h$mul2Word32(l1,l2) {
}
function h$quotWord32(n,d) {
+ TRACE_ARITH("quotWord32 " + n + " " + d);
+
// from Hacker's Delight book (p 192)
// adapted for JavaScript
var t = d >> 31;
@@ -487,6 +520,8 @@ function h$quotWord32(n,d) {
}
function h$remWord32(n,d) {
+ TRACE_ARITH("remWord32 " + n + " " + d);
+
var t = d >> 31;
var n2 = n & ~t;
var q = ((n2 >>> 1) / d) << 1;
@@ -496,6 +531,8 @@ function h$remWord32(n,d) {
}
function h$quotRemWord32(n,d) {
+ TRACE_ARITH("quotRemWord32 " + n + " " + d);
+
var t = d >> 31;
var n2 = n & ~t;
var q = ((n2 >>> 1) / d) << 1;
@@ -505,6 +542,8 @@ function h$quotRemWord32(n,d) {
}
function h$quotRem2Word32(nh,nl,d) {
+ TRACE_ARITH("quotRem2Word32 " + nh + " " + nl + " " + d);
+
// from Hacker's Delight book (p196)
nh = UN(nh);
@@ -560,6 +599,8 @@ function h$quotRem2Word32(nh,nl,d) {
}
function h$wordAdd2(a,b) {
+ TRACE_ARITH("wordAdd2 " + a + " " + b);
+
const a16 = a >>> 16;
const a00 = a & 0xFFFF;
@@ -576,19 +617,6 @@ function h$wordAdd2(a,b) {
RETURN_UBX_TUP2(c32, (c16 << 16) | c00);
}
-// this does an unsigned shift, is that ok?
-function h$uncheckedShiftRL64(h1,l1,n) {
- if(n < 0) throw "unexpected right shift";
- n &= 63;
- if(n == 0) {
- RETURN_UBX_TUP2(h1, l1);
- } else if(n < 32) {
- RETURN_UBX_TUP2((h1 >>> n), (l1 >>> n) | (h1 << (32 - n)));
- } else {
- RETURN_UBX_TUP2(0, (l1 >>> (n - 32))|0);
- }
-}
-
function h$isDoubleNegativeZero(d) {
TRACE_ARITH("isDoubleNegativeZero: " + d);
return (d===0 && (1/d) === -Infinity) ? 1 : 0;
@@ -863,6 +891,7 @@ if(typeof Math.fround === 'function') {
}
function h$decodeDoubleInt64(d) {
+ TRACE_ARITH("decodeDoubleInt64: " + d);
if(isNaN(d)) {
RETURN_UBX_TUP3(972, -1572864, 0);
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/12d3c118933a9c05eb122d8fa51532e02d17d518
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/12d3c118933a9c05eb122d8fa51532e02d17d518
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/be18db4a/attachment-0001.html>
More information about the ghc-commits
mailing list