js-on-sx: bitwise ops & | ^ << >> (+ compound assigns)

lib/js/runtime.sx

@@ -1667,6 +1667,67 @@
         (shift (modulo (js-math-trunc (js-to-number r)) 32)))
       (floor (/ lu32 (js-math-pow 2 shift))))))
 
+(define
+  js-to-uint32
+  (fn (n) (modulo (js-math-trunc (js-to-number n)) 4294967296)))
+
+(define
+  js-uint32-to-int32
+  (fn (u) (if (>= u 2147483648) (- u 4294967296) u)))
+
+(define js-to-int32 (fn (n) (js-uint32-to-int32 (js-to-uint32 n))))
+
+(define
+  js-bitwise-loop
+  (fn
+    (op au bu i acc bit)
+    (if
+      (>= i 32)
+      acc
+      (let
+        ((abit (modulo (floor (/ au bit)) 2))
+          (bbit (modulo (floor (/ bu bit)) 2)))
+        (let
+          ((rbit
+             (cond
+               ((= op "and") (* abit bbit))
+               ((= op "or") (if (or (= abit 1) (= bbit 1)) 1 0))
+               ((= op "xor") (if (= abit bbit) 0 1))
+               (else 0))))
+          (js-bitwise-loop
+            op au bu (+ i 1) (+ acc (* rbit bit)) (* bit 2)))))))
+
+(define
+  js-bitwise-binop
+  (fn
+    (op a b)
+    (js-uint32-to-int32
+      (js-bitwise-loop op (js-to-uint32 a) (js-to-uint32 b) 0 0 1))))
+
+(define js-bitand (fn (a b) (js-bitwise-binop "and" a b)))
+
+(define js-bitor (fn (a b) (js-bitwise-binop "or" a b)))
+
+(define js-bitxor (fn (a b) (js-bitwise-binop "xor" a b)))
+
+(define
+  js-shl
+  (fn
+    (a b)
+    (let
+      ((au (js-to-uint32 a))
+        (sh (modulo (js-math-trunc (js-to-number b)) 32)))
+      (js-uint32-to-int32 (modulo (* au (js-math-pow 2 sh)) 4294967296)))))
+
+(define
+  js-shr
+  (fn
+    (a b)
+    (let
+      ((ai (js-to-int32 a))
+        (sh (modulo (js-math-trunc (js-to-number b)) 32)))
+      (if (= sh 0) ai (floor (/ ai (js-math-pow 2 sh)))))))
+
 (define js-pow (fn (a b) (pow (js-to-number a) (js-to-number b))))
 
 (define js-neg (fn (a) (* -1 (exact->inexact (js-to-number a)))))