master: Perform local common subexpression elimination for some memory loads
snuglas via Sbcl-commits <[email protected]> Tue, 04 Aug 2026 00:59:12 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 100c9c2bdcdcb84ff04c8feef983a5b44695c97a (commit)
from b541f2f25b14b62fcab7e14aa5124db5dd1d6b20 (commit)
- Log -----------------------------------------------------------------
commit 100c9c2bdcdcb84ff04c8feef983a5b44695c97a
Author: Douglas Katzman <[email protected]>
Date: Tue Aug 4 00:58:21 2026 +0000
Perform local common subexpression elimination for some memory loads
The technique is to find "equivalent" loads in between which there is no
computation that affects the result of the load. Also it needs a surrounding
LET, which is augmented with a new temp variable as if the user did that.
This is slightly deficient for various reasons:
1. it won't do anything without the LET
2. the more kinds of common subexpressions we allow (such as math),
the slower IR1-OPTIMIZE-COMBINATION is going to run
3. there are possibly other node types that should be allowed to intervene
On the plus side, it's not all that hard to extend the logic to accept
other functions as participants in common subexpressions.
All test cases plus a little bit of assistance from Gemini
---
src/compiler/ir1opt.lisp | 179 ++++++++++++++++++++++++++++++++++++
tests/lcse.pure.lisp | 234 +++++++++++++++++++++++++++++++++++++++++++++++
xperfecthash30.lisp-expr | 3 +
xperfecthash61.lisp-expr | 3 +
xperfecthash63.lisp-expr | 3 +
5 files changed, 422 insertions(+)
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 8559824f1..dac393e31 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1220,6 +1220,182 @@
(show-type-derivation combination res))
(coerce-to-values res))))))
+(defun collect-lvar-vars (lvar)
+ (declare (type lvar lvar))
+ (let ((use (principal-lvar-use lvar)))
+ (cond ((ref-p use)
+ (let ((leaf (ref-leaf use)))
+ (when (lambda-var-p leaf)
+ (list leaf))))
+ ((combination-p use)
+ (mapcan #'collect-lvar-vars (basic-combination-args use)))
+ (t nil))))
+
+(defun find-active-let-lambda (node)
+ (declare (type node node))
+ (loop for env = (node-lexenv node) then (lexenv-parent env)
+ while env
+ do (let ((l (lexenv-lambda env)))
+ (when (and l
+ (functional-kind-eq l let)
+ (not (functional-kind-eq l zombie)))
+ (return l)))))
+
+(defun add-variable-to-let-lambda (let-lambda v)
+ (declare (type clambda let-lambda)
+ (type lambda-var v))
+ (setf (lambda-var-home v) let-lambda)
+ (setf (lambda-vars let-lambda) (append (lambda-vars let-lambda) (list v)))
+ ;; Update the call to the LET lambda
+ (let* ((ref (car (leaf-refs let-lambda)))
+ (call (and ref
+ (node-lvar ref)
+ (lvar-dest (node-lvar ref)))))
+ (when (and call (combination-p call))
+ (let ((dummy-lvar (make-lvar)))
+ (setf (lvar-dest dummy-lvar) call)
+ (setf (basic-combination-args call)
+ (append (basic-combination-args call) (list dummy-lvar)))
+ (setf (lvar-dest dummy-lvar) call)))))
+
+;; Reuse of SYMBOL-VALUE of a special var would be nice,
+;; but SYMBOL-VALUE it is not represented as a call in IR1
+(define-load-time-global *elidable-memory-loads*
+ '(car cdr %instance-ref %raw-instance-ref/word %raw-instance-ref/signed-word
+ sap-ref-16 signed-sap-ref-16 sb-sys::%sap-ref-16-indexed sb-sys::%signed-sap-ref-16-indexed
+ sap-ref-32 signed-sap-ref-32 sb-sys::%sap-ref-32-indexed sb-sys::%signed-sap-ref-32-indexed
+ sap-ref-64 signed-sap-ref-64 sb-sys::%sap-ref-64-indexed sb-sys::%signed-sap-ref-64-indexed
+ sb-alien:deref
+ sb-alien:alien-sap))
+
+;;; Look for any node equivalent to MATCH consdering nodes in reverse starting at FROM.
+;;; Memory loads from the same object+slot or SAP+offset could be equivalent.
+;;; Nothing else can be equivalent (until I enhance this)
+(defun find-equivalent-node-backwards (match from)
+ (labels ((lvar-equivalent-p (l1 l2)
+ (declare (type lvar l1 l2))
+ (cond ((eq l1 l2) t)
+ ((and (constant-lvar-p l1) (constant-lvar-p l2))
+ (eql (lvar-value l1) (lvar-value l2)))
+ (t
+ (let ((u1 (principal-lvar-use l1))
+ (u2 (principal-lvar-use l2)))
+ (cond ((and (ref-p u1) (ref-p u2))
+ (eq (ref-leaf u1) (ref-leaf u2)))
+ ((and (combination-p u1) (combination-p u2)
+ (eq (basic-combination-kind u1) :known)
+ (eq (basic-combination-kind u2) :known))
+ (combination-equivalent-p u1 u2))
+ (t nil))))))
+ (combination-equivalent-p (c1 c2)
+ (declare (type combination c1 c2))
+ (and (eq (basic-combination-fun-info c1) (basic-combination-fun-info c2))
+ (let ((args1 (basic-combination-args c1))
+ (args2 (basic-combination-args c2)))
+ (and (= (length args1) (length args2))
+ (every #'lvar-equivalent-p args1 args2))))))
+ (do ((node from (ctran-use (node-prev node)))) ((null node))
+ (when (and (combination-p node)
+ (eq (combination-kind node) :known)
+ (node-lvar node)
+ (combination-equivalent-p node match))
+ (return node))
+ (typecase node
+ ((or cset ref cast combination cif))
+ (t
+ ;; Return :FAIL to abort quickly. This could choose to fail if a non-flushable
+ ;; combination is seen, but for now I'm deferring that soundness check.
+ (return-from find-equivalent-node-backwards :fail))))))
+
+;;; Attmpt to find a COMBINATION equivalent to THIS preceding it in node order, the value
+;;; of which can be substituted for the call to THIS, actually making the substitution.
+;;; Looking backwards at most a few blocks tends to work well enough, and inportantly
+;;; limits the work. Scanning only the current block is inadequate as the example
+;;; in :LOOP-OVER-DEREF shows. The immediate predecessor is still not enough, because the
+;;; predecessor could have been split, leaving a tiny block where the only node is
+;;; a trivial operation.
+(defun try-reuse-expr-value (this)
+ (declare (type combination this))
+ (binding*
+ ((home-lambda (find-active-let-lambda this) :exit-if-null)
+ (lookback 0)
+ (c1
+ ;; In this block, explicitly go back a node so that FIND-BACKWARDS doesn't consider THIS
+ ;; as equivalent to itself. Failing that, try predecessor blocks, but only as long as
+ ;; pred is unique since we have no information about nodes that dominate THIS.
+ (or (find-equivalent-node-backwards this (ctran-use (node-prev this)))
+ (do ((pred (block-pred (node-block this))))
+ ((or (> lookback 3) (not (singleton-p pred))))
+ (incf lookback)
+ (let ((node (block-last (car pred))))
+ (when (null node) (return))
+ (awhen (find-equivalent-node-backwards this node) (return it))
+ (setq pred (block-pred (node-block node))))))
+ :exit-if-null)
+ (vars ; can't use :exit-if-null here because VARS can be and usually is NIL
+ (unless (eq c1 :fail)
+ (mapcan #'collect-lvar-vars (basic-combination-args c1)))))
+ (when (eq c1 :fail)
+ (return-from try-reuse-expr-value nil))
+ (labels ((all-flushable (ctran end-node)
+ (declare (ctran ctran) (type (or node null) end-node))
+ (loop (let ((node (ctran-next ctran)))
+ (cond ((eq node end-node) (return t))
+ ((not (ok-to-flush node)) (return nil))
+ ((and (not end-node) (not (node-next node))) (return t)))
+ (setq ctran (node-next node)))))
+ (ok-to-flush (node)
+ (cond ((set-p node) (not (member (set-var node) vars)))
+ ((combination-p node) (flushable-combination-p node))
+ ((basic-combination-p node) nil)
+ (t t)))) ; anything else the backwards search allowed is ok
+ ;; When lookback>0 it's possible for the equivalent node to be the final node
+ ;; of its block, in which case its NODE-NEXT is null.
+ (let* ((this-block (node-block this))
+ (pred (car (block-pred this-block))))
+ (unless (if (= lookback 0)
+ (all-flushable (node-next c1) this)
+ (and
+ ;; Check prev block from C1 to its end of block, and current block up to THIS
+ (acond ((node-next c1) (all-flushable it nil)) (t t))
+ (all-flushable (block-start this-block) this)
+ ;; All check all of one or both intervening blocks
+ (or (< lookback 2)
+ (all-flushable (block-start pred) nil))
+ (or (< lookback 3)
+ (all-flushable (block-start (car (block-pred pred))) nil))))
+ (return-from try-reuse-expr-value nil))))
+ ;; Substitute C1's result in for THIS
+ (binding* ((lvar-c1 (node-lvar c1) :exit-if-null)
+ (consumer-1 (lvar-dest lvar-c1) :exit-if-null)
+ (c2 this)
+ (lvar-c2 (node-lvar c2) :exit-if-null)
+ (v (make-lambda-var (gensym "REUSED-VAL")
+ :type (single-value-type (node-derived-type c1))))
+ (lvar-new (make-lvar)))
+ (add-variable-to-let-lambda home-lambda v)
+
+ ;; 1. Redirect consumer-1 to read from lvar-new
+ (substitute-lvar lvar-new lvar-c1)
+
+ (with-ir1-environment-from-node c1
+ ;; 2. Make C1 write to a new LVAR, and link it to a CSET on V
+ (let ((lvar-c1-new (make-lvar)))
+ (%delete-lvar-use c1)
+ (use-lvar c1 lvar-c1-new)
+ ;; 3. Create S1 (set V = lvar-c1-new) and insert after C1
+ (let ((s1 (make-set v lvar-c1-new)))
+ (setf (lvar-dest lvar-c1-new) s1)
+ (push s1 (basic-var-sets v))
+ (insert-node-after c1 s1))))
+
+ ;; 4. Insert ref1 before consumer-1, writing to lvar-new
+ (insert-ref-before v consumer-1 lvar-new)
+ ;; 5. Insert ref2 before C2, stealing C2's lvar
+ (insert-ref-before v c2 t)
+ ;; C2 is now dead and will be flushed by the caller!
+ t)))
+
;;; Do IR1 optimizations on a COMBINATION node.
(defun ir1-optimize-combination (node &aux (show *show-transforms-p*))
(declare (type combination node))
@@ -1305,6 +1481,9 @@
(not (node-lvar node)))
(return-from ir1-optimize-combination (flush-node node)))
((fold-call-derived-to-constant node)
+ (return-from ir1-optimize-combination))
+ ((and (combination-is node *elidable-memory-loads*)
+ (try-reuse-expr-value node))
(return-from ir1-optimize-combination)))
(when (and (ir1-attributep (fun-info-attributes info) commutative)
(= (length args) 2)
diff --git a/tests/lcse.pure.lisp b/tests/lcse.pure.lisp
new file mode 100644
index 000000000..43b34e998
--- /dev/null
+++ b/tests/lcse.pure.lisp
@@ -0,0 +1,234 @@
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+;;;; Tests of local common subexpression elimination
+
+(import '(ctu:inspect-ir
+ sb-c::combination-fun-debug-name
+ sb-c::basic-combination-p))
+
+(defun ir-calls (form)
+ (let (calls)
+ (inspect-ir
+ form
+ (lambda (component)
+ (ctu:do-blocks (block component)
+ (ctu:do-nodes (node nil block)
+ (when (basic-combination-p node)
+ (push node calls))))))
+ calls))
+
+(defmacro assert-calls (fun-name expected-count (&rest lambda-args) &body body)
+ (sb-int:binding*
+ (((forms decls) (sb-int:parse-body body nil))
+ (lexpr `(lambda (,@lambda-args)
+ ,@decls
+ ;; Without a containing LET form, the current implementation of CSE
+ ;; is unwilling to bind a temporary lambda var for reuse.
+ (let ((active-let-var 0))
+ (print active-let-var)
+ (incf active-let-var (random 5))
+ (print active-let-var)
+ ,@forms))))
+ `(assert (= (count ',fun-name (ir-calls ',lexpr) :key #'combination-fun-debug-name)
+ ,expected-count))))
+
+;;; Basic tests: a sampling of elidable load type with two identical loads
+
+(with-test (:name (:cse :car))
+ (assert-calls car 1 (cons)
+ (declare (type cons cons))
+ (if (car cons)
+ (princ (car cons))
+ (princ (cdr cons)))))
+
+(with-test (:name (:cse :different-names-for-same-object))
+ ;; Y and X refer to the same thing, and it doesn't matter
+ ;; whose CDR we take first. Only one CDR operation is performed
+ (assert-calls cdr 1 (x)
+ (declare (type cons x))
+ (let ((y x))
+ (list (cdr y) (cdr x))))
+ (assert-calls cdr 1 (x)
+ (declare (type cons x))
+ (let ((y x))
+ (list (cdr x) (cdr y)))))
+
+(with-test (:name (:cse :composition-of-cxr))
+ ;; The CAR extraction which is part of the CDAR function can be
+ ;; reused based on the fact that we evaluated (LISTP (CAR X))
+ (assert-calls car 1 (x)
+ (if (listp (car x)) (cdar x)))
+ ;; negative test - CDAR on a different Y is another CAR operation
+ (assert-calls car 2 (x y)
+ (if (listp (car x)) (cdar y))))
+
+(defstruct cse-test-foo slot (wslot 0 :type sb-vm:word))
+(with-test (:name (:cse :instance-ref))
+ (assert-calls sb-kernel:%instance-ref 1 (x)
+ ;; Depending on what TRANSFORM-INSTANCE-TYPEP does, it might access instance-layout
+ ;; using %INSTANCE-REF which would have to be discounted in the call counting.
+ ;; Just brute-force the type to avoid that situation.
+ (let ((x (truly-the cse-test-foo x)))
+ (if (cse-test-foo-slot x)
+ (princ (cse-test-foo-slot x))
+ nil))))
+
+(with-test (:name (:cse :raw-instance-ref/word))
+ (assert-calls sb-kernel:%raw-instance-ref/word 1 (x)
+ (declare (type cse-test-foo x))
+ (if (logtest (cse-test-foo-wslot x) #xff000)
+ (princ (cse-test-foo-wslot x))
+ nil)))
+
+(with-test (:name (:cse :sap-ref-32))
+ (assert-calls sb-sys:sap-ref-32 1 (sap offset)
+ (declare (type sb-sys:system-area-pointer sap)
+ (type sb-vm:word offset))
+ (if (plusp (sb-sys:sap-ref-32 sap offset))
+ (princ (sb-sys:sap-ref-32 sap offset))
+ nil))
+ (assert-calls sb-sys:signed-sap-ref-32 1 (sap offset)
+ (declare (type sb-sys:system-area-pointer sap)
+ (type sb-vm:word offset))
+ (if (plusp (sb-sys:signed-sap-ref-32 sap offset))
+ (princ (sb-sys:signed-sap-ref-32 sap offset))
+ nil)))
+
+(with-test (:name (:cse :sap-ref-64) :skipped-on (:not :64-bit))
+ (assert-calls sb-sys:sap-ref-64 1 (sap offset)
+ (declare (type sb-sys:system-area-pointer sap)
+ (type sb-vm:word offset))
+ (if (plusp (sb-sys:sap-ref-64 sap offset))
+ (princ (sb-sys:sap-ref-64 sap offset))
+ nil))
+ (assert-calls sb-sys:signed-sap-ref-64 1 (sap offset)
+ (declare (type sb-sys:system-area-pointer sap)
+ (type sb-vm:word offset))
+ (if (plusp (sb-sys:signed-sap-ref-64 sap offset))
+ (princ (sb-sys:signed-sap-ref-64 sap offset))
+ nil)))
+
+(with-test (:name (:cse :loop-over-deref))
+ (let ((lexpr
+ '(lambda (f)
+ (declare (optimize (sb-c::alien-funcall-saves-fp-and-pc 0)
+ (sb-c::type-check 0)))
+ ;; F returns a pointer to a null-terminated array of unsigned-int.
+ ;; The deref for the loop termination test, and again in the body
+ ;; should use a single memory load.
+ (let ((a (alien-funcall (the (alien (function (* unsigned))) f))))
+ (do ((index 0 (1+ index)))
+ ((zerop (deref a index)))
+ (princ (the fixnum (deref a index))))))))
+ (assert (= (count #+(or arm64 x86-64) 'sb-sys:%sap-ref-64-indexed
+ #-(or arm64 x86-64)
+ (progn #+64-bit 'sb-sys:sap-ref-64 #-64-bit 'sb-sys:sap-ref-32)
+ (ir-calls lexpr) :key #'combination-fun-debug-name)
+ 1))))
+
+;;; SETQ of a variable used as an argument to an elidable load prevents CSE.
+;;; When a variable that participates in the load expression (e.g., the cons
+;;; being CAR'd) is assigned between two identical loads, the second load
+;;; must not be eliminated because the variable may reference a different object.
+(with-test (:name (:cse :setq-of-load-arg-prevents-car))
+ ;; CONS is the argument to CAR. Assigning CONS between two (CAR CONS)
+ ;; prevents CSE.
+ (assert-calls car 2 (cons other)
+ (declare (type cons cons other))
+ (let ((a (car cons)))
+ (setq cons other)
+ (let ((b (car cons)))
+ (list a b)))))
+
+(with-test (:name (:cse :setq-of-load-arg-prevents-cdr))
+ (assert-calls cdr 2 (cons other)
+ (declare (type cons cons other))
+ (let ((a (cdr cons)))
+ (setq cons other)
+ (let ((b (cdr cons)))
+ (list a b)))))
+
+(with-test (:name (:cse :setq-of-load-arg-prevents-instance-ref))
+ ;; Assigning the struct variable between two reads of the same slot prevents CSE.
+ (assert-calls sb-kernel:%instance-ref 2 (x y)
+ (let ((x (truly-the cse-test-foo x))
+ (y (truly-the cse-test-foo y)))
+ (let ((a (cse-test-foo-slot x)))
+ (setq x y)
+ (let ((b (cse-test-foo-slot x)))
+ (list a b))))))
+
+(with-test (:name (:cse :setq-of-load-arg-prevents-sap-ref))
+ ;; Assigning the SAP variable between two reads at the same offset
+ ;; must prevent CSE since the second read may use a different SAP.
+ (assert-calls sb-sys:sap-ref-32 2 (sap1 sap2 offset)
+ (declare (type sb-sys:system-area-pointer sap1 sap2)
+ (type sb-vm:word offset))
+ (let ((a (sb-sys:sap-ref-32 sap1 offset)))
+ (setq sap1 sap2)
+ (let ((b (sb-sys:sap-ref-32 sap1 offset)))
+ (list a b)))))
+
+;;; SETQ of an *unrelated* variable should NOT prevent CSE.
+;;; Only mutations of variables that participate in the load matter.
+(with-test (:name (:cse :setq-of-unrelated-var-allows-cse))
+ ;; Z is not an argument to CAR, so setting Z does not inhibit CSE.
+ (assert-calls car 1 (cons z)
+ (declare (type cons cons))
+ (let ((a (car cons)))
+ (setq z a)
+ (let ((b (car cons)))
+ (list z b)))))
+
+;;; SB-THREAD:BARRIER of any kind prevents elision of the second load
+;;; since the memory barriers is not flushable. This is the conservative stance.
+;;; The actual (looser) requirements are more subtle than I care to deal with.
+(defmacro barrier-test (kind)
+ `(with-test (:name (:cse :barrier-prevents-car ,kind))
+ (assert-calls car 2 (cons)
+ (declare (type cons cons))
+ (let ((a (car cons)))
+ (sb-thread:barrier (,kind))
+ (let ((b (car cons)))
+ (list a b))))))
+(barrier-test :read)
+(barrier-test :write)
+(barrier-test :memory)
+(barrier-test :compiler)
+(barrier-test :data-dependency)
+
+;;; Any non-flushable call between two identical loads prevents CSE
+;;; because the call may have side effects that modify the loaded memory.
+
+(with-test (:name (:cse :non-flushable-call-prevents-cse))
+ ;; PRINC is a non-flushable
+ (assert-calls car 2 (cons)
+ (declare (type cons cons))
+ (let ((a (car cons)))
+ (princ 42)
+ (let ((b (car cons)))
+ (list a b)))))
+
+;;; Different functions on the same object are NOT considered common subexpressions.
+;;; (CAR x) and (CDR x) are different loads even if x is the same.
+(with-test (:name (:cse :different-accessors-not-cse))
+ ;; Both CAR and CDR should appear, each exactly once.
+ (assert-calls car 1 (cons)
+ (declare (type cons cons))
+ (if (car cons)
+ (princ (cdr cons))
+ nil))
+ (assert-calls cdr 1 (cons)
+ (declare (type cons cons))
+ (if (car cons)
+ (princ (cdr cons))
+ nil)))
diff --git a/xperfecthash30.lisp-expr b/xperfecthash30.lisp-expr
index 6a503acf0..1b7227c78 100644
--- a/xperfecthash30.lisp-expr
+++ b/xperfecthash30.lisp-expr
@@ -1506,6 +1506,9 @@
(#(10BE7277 12214AE8 12E2CBDA 19739539 1F3556C7 1F644387)
"(INTEGER BIGNUM SB-VM::UNSIGNED-BYTE-31 SB-VM::SIGNED-BYTE-32 FIXNUM SB-VM::POSITIVE-FIXNUM)"
"((& (^ val (>> val 22)) 7))")
+(#(10D2EA4E 1224C557 15A58D85 15B5A2B5 17524A78 1769E419 18906D08)
+ "(SB-C::CSET SB-C::REF DELAY SB-C::ARRAY-INDEX-CAST CAST SB-C::COMBINATION SB-C::CIF)"
+ "((& (+ (>> val 1) (>> val 9)) 7))")
(#(10D2EA4E 1224C557 15A58D85 15B5A2B5 17524A78 1769E419 18906D08 19577539 1C065CB8 1D66C932)
"#(((:TYPE SB-C::REF)) ((:TYPE SB-C::COMBINATION)) ((:TYPE SB-C::CIF)) ((:TYPE SB-C::CRETURN)) ((:TYPE SB-C::MV-COMBINATION)) ((:TYPE EXIT)) ((:TYPE SB-C::CSET)) ((:TYPE DELAY) (:TYPE SB-C::ARRAY-INDEX-CAST) (:TYPE CAST)))"
"((let ((tab #a((8) (unsigned-byte 8) 0 5 2 8 13 3 0 0)))
diff --git a/xperfecthash61.lisp-expr b/xperfecthash61.lisp-expr
index 6eb72486b..b1bc014fb 100644
--- a/xperfecthash61.lisp-expr
+++ b/xperfecthash61.lisp-expr
@@ -463,6 +463,9 @@
(#(9A320D4 39CAA339 43BBEE18 4D61368F 53222DFB BFA86189 EDA1037F FEE99A95)
"#(((:TYPE SB-C::REF)) ((:TYPE SB-C::COMBINATION)) ((:TYPE SB-C::MV-COMBINATION)) ((:TYPE EXIT)) ((:TYPE SB-C::CSET)) ((:TYPE DELAY) (:TYPE SB-C::ARRAY-INDEX-CAST) (:TYPE CAST)))"
"((& (- (>> val 3) (>> val 29)) 7))")
+(#(9A320D4 39CAA339 43BBEE18 53222DFB 9380837C BFA86189 FEE99A95)
+ "#(((:TYPE SB-C::CIF) (:TYPE SB-C::COMBINATION) (:TYPE DELAY) (:TYPE SB-C::ARRAY-INDEX-CAST) (:TYPE CAST) (:TYPE SB-C::REF) (:TYPE SB-C::CSET)))"
+ "((& (+ val (>> val 31)) 7))")
(#(9A320D4 43BBEE18 53222DFB A8A4C7D2 BFA86189 EAA3DA5C FEE99A95)
"#(((:TYPE SB-C::REF)) ((:TYPE DELAY) (:TYPE SB-C::ARRAY-INDEX-CAST) (:TYPE CAST)) ((:TYPE SB-C::COMBINATION)) ((:TYPE SB-C::ENTRY)) ((:TYPE SB-C::ENCLOSE)))"
"((& (^ (>> val 7) (>> val 23)) 7))")
diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
index cc861bb33..13bb5d85d 100644
--- a/xperfecthash63.lisp-expr
+++ b/xperfecthash63.lisp-expr
@@ -870,6 +870,9 @@
(#(121068DD 4D61368F 58110E7F 67EE2D1A 6D9A883D 74589D82 897B4656 A68A3965)
"#(((:TYPE SB-C::REF)) ((:TYPE SB-C::COMBINATION)) ((:TYPE SB-C::MV-COMBINATION)) ((:TYPE EXIT)) ((:TYPE SB-C::CSET)) ((:TYPE DELAY) (:TYPE SB-C::ARRAY-INDEX-CAST) (:TYPE CAST)))"
"((& (- (>> val 4) (>> val 16)) 7))")
+(#(121068DD 58110E7F 67EE2D1A 6D9A883D 742D4C54 897B4656 A68A3965)
+ "#(((:TYPE SB-C::CIF) (:TYPE SB-C::COMBINATION) (:TYPE DELAY) (:TYPE SB-C::ARRAY-INDEX-CAST) (:TYPE CAST) (:TYPE SB-C::REF) (:TYPE SB-C::CSET)))"
+ "((& (- (>> val 4) (>> val 16)) 7))")
(#(126ADB02 31B095DD 42D83FFB 4341F7D8 63C971D7 7A80F201 7B408880 8F7912D6 EBD01872)
"(:ALLOW-OTHER-KEYS :TYPE :RESULT-SPECS :ARG-SPECS :CALLER :DEPS :FIRED :LEXENV :SOURCE-PATH)"
"((let ((tab #a((8) (unsigned-byte 8) 0 5 0 3 0 5 12 6)))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL