diff --git a/plugins/arm/semantics/arm.lisp b/plugins/arm/semantics/arm.lisp index b14e62c49..6e44cf670 100644 --- a/plugins/arm/semantics/arm.lisp +++ b/plugins/arm/semantics/arm.lisp @@ -6,4 +6,4 @@ (defun CLZ (rd rn pre _) (when (condition-holds pre) - (set$ rd (clz32 rn)))) + (set$ rd (clz rn)))) diff --git a/plugins/primus_lisp/semantics/bits.lisp b/plugins/primus_lisp/semantics/bits.lisp index d5c5f3bdc..5dcee002d 100644 --- a/plugins/primus_lisp/semantics/bits.lisp +++ b/plugins/primus_lisp/semantics/bits.lisp @@ -26,35 +26,85 @@ (logor (logand (msb rn) (msb rm) (lnot (msb rd))) (logand (lnot (msb rn)) (lnot (msb rm)) (msb rd)))) -(defmacro popcount/helper (x sh m1 m2 m4 h01) - (prog - (set x (- x (logand (rshift x 1) m1))) - (set x (+ (logand x m2) (logand (rshift x 2) m2))) - (set x (logand (+ x (rshift x 4)) m4)) - (rshift (* x h01) sh))) - -(defmacro popcount16 (x) +(defun clz (x) + "(clz X) counts leading zeros in X. + The returned value is the number of consecutive zeros starting + from the most significant bit. Returns 0 for 0 and works for + inputs of any size, including inputs that are not statically + known. In the latter case, the computation is unfolded into + the loopless code with the size proportional to the size of word + divided by 64." + (case (word-width x) + 8 (clz8 x) + 16 (clz16 x) + 32 (clz32 x) + 64 (clz64 x) + (if (> (word-width x) 64) + (clz/rec x) + (clz/small x)))) + +(defun popcount (x) + "(popcount X) computes the total number of 1 bits in X." + (if (> (word-width x) 64) + (+ (popcount64 (cast-high 64 x)) + (popcount (cast-low (- (word-width x) 64) x))) + (if (= (word-width x) 64) + (popcount64 x) + (popcount64 (cast-unsigned 64 x))))) + +;; private helpers + +(defun popcount/helper (x sh m1 m2 m4 h01) + (declare (visibility :private)) + (let ((x x)) + (set x (- x (logand (rshift x 1) m1))) + (set x (+ (logand x m2) (logand (rshift x 2) m2))) + (set x (logand (+ x (rshift x 4)) m4)) + (rshift (* x h01) sh))) + +(defun popcount8 (x) + (declare (visibility :private)) + (popcount/helper x 0 + 0x55:8 + 0x33:8 + 0x0f:8 + 0x01:8)) + +(defun popcount16 (x) + (declare (visibility :private)) (popcount/helper x 8 - 0x5555 - 0x3333 - 0x0f0f - 0x0101)) + 0x5555:16 + 0x3333:16 + 0x0f0f:16 + 0x0101:16)) -(defmacro popcount32 (x) +(defun popcount32 (x) + (declare (visibility :private)) (popcount/helper x 24 - 0x55555555 - 0x33333333 - 0x0f0f0f0f - 0x01010101)) + 0x55555555:32 + 0x33333333:32 + 0x0f0f0f0f:32 + 0x01010101:32)) -(defmacro popcount64 (x) +(defun popcount64 (x) + (declare (visibility :private)) (popcount/helper x 56 - 0x5555555555555555 - 0x3333333333333333 - 0x0f0f0f0f0f0f0f0f - 0x0101010101010101)) + 0x5555555555555555:64 + 0x3333333333333333:64 + 0x0f0f0f0f0f0f0f0f:64 + 0x0101010101010101:64)) + +(defun clz8 (r) + (declare (visibility :private)) + (let ((x r)) + (set x (logor x (rshift x 1))) + (set x (logor x (rshift x 2))) + (set x (logor x (rshift x 4))) + (set x (lnot x)) + (popcount8 x))) (defun clz16 (r) + (declare (visibility :private)) (let ((x r)) (set x (logor x (rshift x 1))) (set x (logor x (rshift x 2))) @@ -64,6 +114,7 @@ (popcount16 x))) (defun clz32 (x) + (declare (visibility :private)) (let ((x x)) (set x (logor x (rshift x 1))) (set x (logor x (rshift x 2))) @@ -74,6 +125,7 @@ (popcount32 x))) (defun clz64 (x) + (declare (visibility :private)) (let ((x x)) (set x (logor x (rshift x 1))) (set x (logor x (rshift x 2))) @@ -83,3 +135,20 @@ (set x (logor x (rshift x 32))) (set x (lnot x)) (popcount64 x))) + +(defun clz/rec (x) + (declare (visibility :private)) + (if (> (word-width x) 64) + (if (is-zero (cast-high 64 x)) + (+ 64 (clz (cast-low (- (word-width x) 64) x))) + (clz64 (cast-high 64 x))) + (clz x))) + +(defun clz/small (x) + (declare (visibility :private)) + (let ((w (word-width x))) + (if (< w 8) (- (clz8 (cast-unsigned 8 x)) (- 8 w)) + (if (< w 16) (- (clz16 (cast-unsigned 16 x)) (- 16 w)) + (if (< w 32) (- (clz32 (cast-unsigned 32 x)) (- 32 w)) + (if (< w 64) (- (clz64 (cast-unsigned 64 x)) (- 64 w)) + (clz x)))))))