Re: master: Perform local common subexpression elimination for some memory loads
Charles Zhang via Sbcl-commits <[email protected]> Tue, 4 Aug 2026 10:09:14 +0000 (UTC)
| Newsgroups | gmane.lisp.steel-bank.cvs,gmane.lisp.steel-bank.devel,gmane.lisp.steel-bank.devel |
|---|---|
| Message-ID | <[email protected]> |
--===============6044065898161819733== Content-Type: multipart/alternative; boundary="----=_Part_1714915_1527299352.1785838154448" Content-Length: 104653 ------=_Part_1714915_1527299352.1785838154448 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Wouldn=E2=80=99t this optimization=C2=A0be better off done in IR2? If we ar= e working hard to approximate what the vops and memory loads would end up d= oing. Many advantages: - Possible to estimate whether it would impact stack usage.- Cost model wit= h register allocator possible- Accurate vop costs- No shenanigans around di= fferent lambda=C2=A0representations- TNs are more amenable to value numberi= ng.- Environment analysis already done.- Ir1 optimizers not impacted- Type = checking possible to CSE Especially because local CSE does not trigger other front end optimizations= or improve type inference. On Tuesday, August 4, 2026, 6:18 AM, Stas Boukarev <[email protected]> wro= te: (defun j2 (x n) =C2=A0 (declare (optimize (debug 0))) =C2=A0 (let ((y (1+ x))) =C2=A0 =C2=A0 (list (1+ (car n)) =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (car n) =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (cdr n) =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 y y))) increases stack usage due to having to save the new shared variable on the stack. On Tue, Aug 4, 2026 at 7:04=E2=80=AFAM Stas Boukarev <[email protected]> w= rote: > > (defun k (x n) >=C2=A0 (let ((y (1+ x))) >=C2=A0 =C2=A0 (values y y >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (eq (car (copy-tree n)) >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (car (copy-tree n)= ))))) > =3D> > (k 1 '((1))) > =3D> > 2 > 2 > T > > On Tue, Aug 4, 2026 at 6:47=E2=80=AFAM Stas Boukarev <[email protected]>= wrote: > > > > (defun j (x) > >=C2=A0 (let ((y (1+ x))) > >=C2=A0 =C2=A0 (values y y > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (car *) > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (setf * '(b)) > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (car *)))) > > (let ((* '(a))) (j 1)) > > =3D> > > 2 > > 2 > > A > > (B) > > A > > > > On Tue, Aug 4, 2026 at 4:22=E2=80=AFAM Stas Boukarev <[email protected]= m> wrote: > > > > > > (defstruct s > > >=C2=A0 (x (make-array 3))) > > > > > > (let (*) > > >=C2=A0 (lambda () > > >=C2=A0 =C2=A0 (let* ((s #.(make-s)) > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (a (s-x s)) > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (b (s-x s))) > > >=C2=A0 =C2=A0 =C2=A0 (values (aref a 0) > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (aref b 0))))) > > > > > > > > > debugger invoked on a SB-INT:BUG @B8007B85AD in thread > > > #<THREAD tid=3D1986402 "main thread" RUNNING {12014F0003}>: > > >=C2=A0 =C2=A0 failed AVER: (EQ ENV (LAMBDA-ENVIRONMENT (LAMBDA-VAR-HOM= E THING))) > > > > > > On Tue, Aug 4, 2026 at 3:59=E2=80=AFAM snuglas via Sbcl-commits > > > <[email protected]> wrote: > > > > > > > > The branch "master" has been updated in SBCL: > > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 via=C2=A0 100c9c2bdcdcb84ff04c8feef983a5= b44695c97a (commit) > > > >=C2=A0 =C2=A0 =C2=A0 from=C2=A0 b541f2f25b14b62fcab7e14aa5124db5dd1d= 6b20 (commit) > > > > > > > > - Log -------------------------------------------------------------= ---- > > > > commit 100c9c2bdcdcb84ff04c8feef983a5b44695c97a > > > > Author: Douglas Katzman <[email protected]> > > > > Date:=C2=A0 Tue Aug 4 00:58:21 2026 +0000 > > > > > > > >=C2=A0 =C2=A0 Perform local common subexpression elimination for som= e memory loads > > > > > > > >=C2=A0 =C2=A0 The technique is to find "equivalent" loads in between= which there is no > > > >=C2=A0 =C2=A0 computation that affects the result of the load. Also = it needs a surrounding > > > >=C2=A0 =C2=A0 LET, which is augmented with a new temp variable as if= the user did that. > > > >=C2=A0 =C2=A0 This is slightly deficient for various reasons: > > > >=C2=A0 =C2=A0 1. it won't do anything without the LET > > > >=C2=A0 =C2=A0 2. the more kinds of common subexpressions we allow (s= uch as math), > > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 the slower IR1-OPTIMIZE-COMBINATION is g= oing to run > > > >=C2=A0 =C2=A0 3. there are possibly other node types that should be = allowed to intervene > > > > > > > >=C2=A0 =C2=A0 On the plus side, it's not all that hard to extend the= logic to accept > > > >=C2=A0 =C2=A0 other functions as participants in common subexpressio= ns. > > > > > > > >=C2=A0 =C2=A0 All test cases plus a little bit of assistance from Ge= mini > > > > --- > > > >=C2=A0 src/compiler/ir1opt.lisp | 179 ++++++++++++++++++++++++++++++= ++++++ > > > >=C2=A0 tests/lcse.pure.lisp=C2=A0 =C2=A0 | 234 +++++++++++++++++++++= ++++++++++++++++++++++++++ > > > >=C2=A0 xperfecthash30.lisp-expr |=C2=A0 3 + > > > >=C2=A0 xperfecthash61.lisp-expr |=C2=A0 3 + > > > >=C2=A0 xperfecthash63.lisp-expr |=C2=A0 3 + > > > >=C2=A0 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 @@ > > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (show-type-derivati= on combination res)) > > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (coerce-to-values res)))))= ) > > > > > > > > +(defun collect-lvar-vars (lvar) > > > > +=C2=A0 (declare (type lvar lvar)) > > > > +=C2=A0 (let ((use (principal-lvar-use lvar))) > > > > +=C2=A0 =C2=A0 (cond ((ref-p use) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (let ((leaf (ref-leaf use))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (when (lambda-var-p leaf= ) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (list leaf)))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((combination-p use) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (mapcan #'collect-lvar-vars (ba= sic-combination-args use))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (t nil)))) > > > > + > > > > +(defun find-active-let-lambda (node) > > > > +=C2=A0 (declare (type node node)) > > > > +=C2=A0 (loop for env =3D (node-lexenv node) then (lexenv-parent en= v) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 while env > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 do (let ((l (lexenv-lambda env))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (when (and l > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (functional-kind-eq l let) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (not (functional-kind-eq l zombie))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (return l))))) > > > > + > > > > +(defun add-variable-to-let-lambda (let-lambda v) > > > > +=C2=A0 (declare (type clambda let-lambda) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (type lambda-var v)) > > > > +=C2=A0 (setf (lambda-var-home v) let-lambda) > > > > +=C2=A0 (setf (lambda-vars let-lambda) (append (lambda-vars let-lam= bda) (list v))) > > > > +=C2=A0 ;; Update the call to the LET lambda > > > > +=C2=A0 (let* ((ref (car (leaf-refs let-lambda))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (call (and ref > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (node-lvar ref) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (lvar-dest (node-lvar ref))))) > > > > +=C2=A0 =C2=A0 (when (and call (combination-p call)) > > > > +=C2=A0 =C2=A0 =C2=A0 (let ((dummy-lvar (make-lvar))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (setf (lvar-dest dummy-lvar) call) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (setf (basic-combination-args call) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (append (basic-co= mbination-args call) (list dummy-lvar))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (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* > > > > +=C2=A0 =C2=A0 '(car cdr %instance-ref %raw-instance-ref/word %raw-= instance-ref/signed-word > > > > +=C2=A0 =C2=A0 =C2=A0 sap-ref-16 signed-sap-ref-16 sb-sys::%sap-ref= -16-indexed sb-sys::%signed-sap-ref-16-indexed > > > > +=C2=A0 =C2=A0 =C2=A0 sap-ref-32 signed-sap-ref-32 sb-sys::%sap-ref= -32-indexed sb-sys::%signed-sap-ref-32-indexed > > > > +=C2=A0 =C2=A0 =C2=A0 sap-ref-64 signed-sap-ref-64 sb-sys::%sap-ref= -64-indexed sb-sys::%signed-sap-ref-64-indexed > > > > +=C2=A0 =C2=A0 =C2=A0 sb-alien:deref > > > > +=C2=A0 =C2=A0 =C2=A0 sb-alien:alien-sap)) > > > > + > > > > +;;; Look for any node equivalent to MATCH consdering nodes in reve= rse 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) > > > > +=C2=A0 (labels ((lvar-equivalent-p (l1 l2) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (declare (type lvar l1 l= 2)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (cond ((eq l1 l2) t) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((a= nd (constant-lvar-p l1) (constant-lvar-p l2)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (eql (lvar-value l1) (lvar-value l2))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (t > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (let ((u1 (principal-lvar-use l1)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 (u2 (principal-lvar-use l2))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (cond ((and (ref-p u1) (ref-p u2)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (eq (ref-leaf u1) (ref-leaf u2))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((and (combination-p u1) (combination-p u2) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (eq (basic-combination= -kind u1) :known) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (eq (basic-combination= -kind u2) :known)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (combination-equivalent-p u1 u2)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (t nil)))))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (combination-equivalent-p (c1 c= 2) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (declare (type combinati= on c1 c2)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (and (eq (basic-combinat= ion-fun-info c1) (basic-combination-fun-info c2)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (le= t ((args1 (basic-combination-args c1)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (args2 (basic-combination-args c2))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (and (=3D (length args1) (length args2)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (every #'lvar-equivalent-p args1 args2)))))) > > > > +=C2=A0 =C2=A0 (do ((node from (ctran-use (node-prev node)))) ((nul= l node)) > > > > +=C2=A0 =C2=A0 =C2=A0 (when (and (combination-p node) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (eq (combi= nation-kind node) :known) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (node-lvar= node) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (combinati= on-equivalent-p node match)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (return node)) > > > > +=C2=A0 =C2=A0 =C2=A0 (typecase node > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 ((or cset ref cast combination cif)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (t > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; Return :FAIL to abort quickly. This= could choose to fail if a non-flushable > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; combination is seen, but for now I'= m deferring that soundness check. > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (return-from find-equivalent-node-back= wards :fail)))))) > > > > + > > > > +;;; Attmpt to find a COMBINATION equivalent to THIS preceding it i= n node order, the value > > > > +;;; of which can be substituted for the call to THIS, actually mak= ing the substitution. > > > > +;;; Looking backwards at most a few blocks tends to work well enou= gh, 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) > > > > +=C2=A0 (declare (type combination this)) > > > > +=C2=A0 (binding* > > > > +=C2=A0 =C2=A0 =C2=A0 ((home-lambda (find-active-let-lambda this) := exit-if-null) > > > > +=C2=A0 =C2=A0 =C2=A0 (lookback 0) > > > > +=C2=A0 =C2=A0 =C2=A0 (c1 > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; In this block, explicitly go back a= node so that FIND-BACKWARDS doesn't consider THIS > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; as equivalent to itself. Failing th= at, try predecessor blocks, but only as long as > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; pred is unique since we have no inf= ormation about nodes that dominate THIS. > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (or (find-equivalent-node-backwards th= is (ctran-use (node-prev this))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (do ((pred (block-pred (= node-block this)))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((or (> lo= okback 3) (not (singleton-p pred)))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (incf lookback) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (let ((node (bloc= k-last (car pred)))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (when (nul= l node) (return)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (awhen (fi= nd-equivalent-node-backwards this node) (return it)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (setq pred= (block-pred (node-block node)))))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 :exit-if-null) > > > > +=C2=A0 =C2=A0 =C2=A0 (vars ; can't use :exit-if-null here because = VARS can be and usually is NIL > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (unless (eq c1 :fail) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (mapcan #'collect-lvar-vars (ba= sic-combination-args c1))))) > > > > +=C2=A0 =C2=A0 (when (eq c1 :fail) > > > > +=C2=A0 =C2=A0 =C2=A0 (return-from try-reuse-expr-value nil)) > > > > +=C2=A0 =C2=A0 (labels ((all-flushable (ctran end-node) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (declare (ctran c= tran) (type (or node null) end-node)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (loop (let ((node= (ctran-next ctran))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (cond ((eq node end-node) (return t)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((not (ok-to-flush node)) (return nil)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((and (not end-node) (not (node-next node))= ) (return t))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (setq ctran (node-next node))))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (ok-to-flush (node) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (cond ((set-p nod= e) (not (member (set-var node) vars))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 ((combination-p node) (flushable-combination-p node)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 ((basic-combination-p node) nil) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (t t)))) ; anything else the backwards search allowed is ok > > > > +=C2=A0 =C2=A0 =C2=A0 ;; When lookback>0 it's possible for the equi= valent node to be the final node > > > > +=C2=A0 =C2=A0 =C2=A0 ;; of its block, in which case its NODE-NEXT = is null. > > > > +=C2=A0 =C2=A0 =C2=A0 (let* ((this-block (node-block this)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (pred (car (block-pred t= his-block)))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (unless (if (=3D lookback 0) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (all-flushable (node-next c1) this) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (and > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 ;; Check prev block from C1 to its end of block, and current block up t= o THIS > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (acond ((node-next c1) (all-flushable it nil)) (t t)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (all-flushable (block-start this-block) this) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 ;; All check all of one or both intervening blocks > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (or (< lookback 2) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (all-flushable (block-start pred) nil)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (or (< lookback 3) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (all-flushable (block-start (car (block-pred pred))) nil)= ))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (return-from try-reuse-expr-val= ue nil)))) > > > > +=C2=A0 =C2=A0 ;; Substitute C1's result in for THIS > > > > +=C2=A0 =C2=A0 (binding* ((lvar-c1 (node-lvar c1) :exit-if-null) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (consumer-1 (lvar= -dest lvar-c1) :exit-if-null) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (c2 this) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (lvar-c2 (node-lv= ar c2) :exit-if-null) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (v (make-lambda-v= ar (gensym "REUSED-VAL") > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 :type (single-value-ty= pe (node-derived-type c1)))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (lvar-new (make-l= var))) > > > > +=C2=A0 =C2=A0 =C2=A0 (add-variable-to-let-lambda home-lambda v) > > > > + > > > > +=C2=A0 =C2=A0 =C2=A0 ;; 1. Redirect consumer-1 to read from lvar-n= ew > > > > +=C2=A0 =C2=A0 =C2=A0 (substitute-lvar lvar-new lvar-c1) > > > > + > > > > +=C2=A0 =C2=A0 =C2=A0 (with-ir1-environment-from-node c1 > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; 2. Make C1 write to a new LVAR, and= link it to a CSET on V > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (let ((lvar-c1-new (make-lvar))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (%delete-lvar-use c1) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (use-lvar c1 lvar-c1-new) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; 3. Create S1 (set V =3D lvar= -c1-new) and insert after C1 > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (let ((s1 (make-set v lvar-c1-n= ew))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (setf (lvar-dest lvar-c1= -new) s1) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (push s1 (basic-var-sets= v)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (insert-node-after c1 s1= )))) > > > > + > > > > +=C2=A0 =C2=A0 =C2=A0 ;; 4. Insert ref1 before consumer-1, writing = to lvar-new > > > > +=C2=A0 =C2=A0 =C2=A0 (insert-ref-before v consumer-1 lvar-new) > > > > +=C2=A0 =C2=A0 =C2=A0 ;; 5. Insert ref2 before C2, stealing C2's lv= ar > > > > +=C2=A0 =C2=A0 =C2=A0 (insert-ref-before v c2 t) > > > > +=C2=A0 =C2=A0 =C2=A0 ;; C2 is now dead and will be flushed by the = caller! > > > > +=C2=A0 =C2=A0 =C2=A0 t))) > > > > + > > > >=C2=A0 ;;; Do IR1 optimizations on a COMBINATION node. > > > >=C2=A0 (defun ir1-optimize-combination (node &aux (show *show-transf= orms-p*)) > > > >=C2=A0 =C2=A0 (declare (type combination node)) > > > > @@ -1305,6 +1481,9 @@ > > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (not (node-lvar node))) > > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (return-from ir1-optimize-combination (flush-node node))) > > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((fol= d-call-derived-to-constant node) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (re= turn-from ir1-optimize-combination)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((and (com= bination-is node *elidable-memory-loads*) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (try-reuse-expr-value node)) > > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (return-from ir1-optimize-combination))) > > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (when (and (ir1-attributep= (fun-info-attributes info) commutative) > > > >=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (=3D (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 tes= t > > > > +;;;; files (like this one) were written from scratch after the for= k > > > > +;;;; 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 > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 sb-c::combination-fun-debug-nam= e > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 sb-c::basic-combination-p)) > > > > + > > > > +(defun ir-calls (form) > > > > +=C2=A0 (let (calls) > > > > +=C2=A0 =C2=A0 (inspect-ir > > > > +=C2=A0 =C2=A0 form > > > > +=C2=A0 =C2=A0 (lambda (component) > > > > +=C2=A0 =C2=A0 =C2=A0 (ctu:do-blocks (block component) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (ctu:do-nodes (node nil block) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (when (basic-combination-p node= ) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (push node calls)))))) > > > > +=C2=A0 =C2=A0 calls)) > > > > + > > > > +(defmacro assert-calls (fun-name expected-count (&rest lambda-args= ) &body body) > > > > +=C2=A0 (sb-int:binding* > > > > +=C2=A0 =C2=A0 =C2=A0 (((forms decls) (sb-int:parse-body body nil)) > > > > +=C2=A0 =C2=A0 =C2=A0 (lexpr `(lambda (,@lambda-args) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ,@decls > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; = Without a containing LET form, the current implementation of CSE > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; = is unwilling to bind a temporary lambda var for reuse. > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (le= t ((active-let-var 0)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (print active-let-var) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (incf active-let-var (random 5)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (print active-let-var) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 ,@forms)))) > > > > +=C2=A0 =C2=A0 `(assert (=3D (count ',fun-name (ir-calls ',lexpr) := key #'combination-fun-debug-name) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ,expected-= count)))) > > > > + > > > > +;;; Basic tests: a sampling of elidable load type with two identic= al loads > > > > + > > > > +(with-test (:name (:cse :car)) > > > > +=C2=A0 (assert-calls car 1 (cons) > > > > +=C2=A0 =C2=A0 (declare (type cons cons)) > > > > +=C2=A0 =C2=A0 (if (car cons) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (car cons)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (cdr cons))))) > > > > + > > > > +(with-test (:name (:cse :different-names-for-same-object)) > > > > +=C2=A0 ;; Y and X refer to the same thing, and it doesn't matter > > > > +=C2=A0 ;; whose CDR we take first. Only one CDR operation is perfo= rmed > > > > +=C2=A0 (assert-calls cdr 1 (x) > > > > +=C2=A0 =C2=A0 (declare (type cons x)) > > > > +=C2=A0 =C2=A0 (let ((y x)) > > > > +=C2=A0 =C2=A0 =C2=A0 (list (cdr y) (cdr x)))) > > > > +=C2=A0 (assert-calls cdr 1 (x) > > > > +=C2=A0 =C2=A0 (declare (type cons x)) > > > > +=C2=A0 =C2=A0 (let ((y x)) > > > > +=C2=A0 =C2=A0 =C2=A0 (list (cdr x) (cdr y))))) > > > > + > > > > +(with-test (:name (:cse :composition-of-cxr)) > > > > +=C2=A0 ;; The CAR extraction which is part of the CDAR function ca= n be > > > > +=C2=A0 ;; reused based on the fact that we evaluated (LISTP (CAR X= )) > > > > +=C2=A0 (assert-calls car 1 (x) > > > > +=C2=A0 =C2=A0 (if (listp (car x)) (cdar x))) > > > > +=C2=A0 ;; negative test - CDAR on a different Y is another CAR ope= ration > > > > +=C2=A0 (assert-calls car 2 (x y) > > > > +=C2=A0 =C2=A0 (if (listp (car x)) (cdar y)))) > > > > + > > > > +(defstruct cse-test-foo slot (wslot 0 :type sb-vm:word)) > > > > +(with-test (:name (:cse :instance-ref)) > > > > +=C2=A0 (assert-calls sb-kernel:%instance-ref 1 (x) > > > > +=C2=A0 =C2=A0 ;; Depending on what TRANSFORM-INSTANCE-TYPEP does, = it might access instance-layout > > > > +=C2=A0 =C2=A0 ;; using %INSTANCE-REF which would have to be discou= nted in the call counting. > > > > +=C2=A0 =C2=A0 ;; Just brute-force the type to avoid that situation= . > > > > +=C2=A0 =C2=A0 (let ((x (truly-the cse-test-foo x))) > > > > +=C2=A0 =C2=A0 =C2=A0 (if (cse-test-foo-slot x) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (cse-test-foo-slot x)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 nil)))) > > > > + > > > > +(with-test (:name (:cse :raw-instance-ref/word)) > > > > +=C2=A0 (assert-calls sb-kernel:%raw-instance-ref/word 1 (x) > > > > +=C2=A0 =C2=A0 (declare (type cse-test-foo x)) > > > > +=C2=A0 =C2=A0 (if (logtest (cse-test-foo-wslot x) #xff000) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (cse-test-foo-wslot x)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 nil))) > > > > + > > > > +(with-test (:name (:cse :sap-ref-32)) > > > > +=C2=A0 (assert-calls sb-sys:sap-ref-32 1 (sap offset) > > > > +=C2=A0 =C2=A0 (declare (type sb-sys:system-area-pointer sap) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (type sb-vm:word offset)= ) > > > > +=C2=A0 =C2=A0 (if (plusp (sb-sys:sap-ref-32 sap offset)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (sb-sys:sap-ref-32 sap offset)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 nil)) > > > > +=C2=A0 (assert-calls sb-sys:signed-sap-ref-32 1 (sap offset) > > > > +=C2=A0 =C2=A0 (declare (type sb-sys:system-area-pointer sap) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (type sb-vm:word offset)= ) > > > > +=C2=A0 =C2=A0 (if (plusp (sb-sys:signed-sap-ref-32 sap offset)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (sb-sys:signed-sap-ref-32 sap o= ffset)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 nil))) > > > > + > > > > +(with-test (:name (:cse :sap-ref-64) :skipped-on (:not :64-bit)) > > > > +=C2=A0 (assert-calls sb-sys:sap-ref-64 1 (sap offset) > > > > +=C2=A0 =C2=A0 (declare (type sb-sys:system-area-pointer sap) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (type sb-vm:word offset)= ) > > > > +=C2=A0 =C2=A0 (if (plusp (sb-sys:sap-ref-64 sap offset)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (sb-sys:sap-ref-64 sap offset)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 nil)) > > > > +=C2=A0 (assert-calls sb-sys:signed-sap-ref-64 1 (sap offset) > > > > +=C2=A0 =C2=A0 (declare (type sb-sys:system-area-pointer sap) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (type sb-vm:word offset)= ) > > > > +=C2=A0 =C2=A0 (if (plusp (sb-sys:signed-sap-ref-64 sap offset)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (sb-sys:signed-sap-ref-64 sap o= ffset)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 nil))) > > > > + > > > > +(with-test (:name (:cse :loop-over-deref)) > > > > +=C2=A0 (let ((lexpr > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 '(lambda (f) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (declare (optimize (sb-c= ::alien-funcall-saves-fp-and-pc 0) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (sb-c::type-check 0))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; F returns a pointer t= o a null-terminated array of unsigned-int. > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; The deref for the loo= p termination test, and again in the body > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; should use a single m= emory load. > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (let ((a (alien-funcall = (the (alien (function (* unsigned))) f)))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (do ((index 0 (1+= index))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((z= erop (deref a index))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (th= e fixnum (deref a index)))))))) > > > > +=C2=A0 =C2=A0 (assert (=3D (count #+(or arm64 x86-64) 'sb-sys:%sap= -ref-64-indexed > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 #-(or arm64 x86-64) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (progn #+64-bit 'sb-sys:sap-ref-64 #-64-bit 'sb-sys:sap-ref-32) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 (ir-calls lexpr) :key #'combination-fun-debug-name) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 1)))) > > > > + > > > > +;;; SETQ of a variable used as an argument to an elidable load pre= vents CSE. > > > > +;;; When a variable that participates in the load expression (e.g.= , the cons > > > > +;;; being CAR'd) is assigned between two identical loads, the seco= nd load > > > > +;;; must not be eliminated because the variable may reference a di= fferent object. > > > > +(with-test (:name (:cse :setq-of-load-arg-prevents-car)) > > > > +=C2=A0 ;; CONS is the argument to CAR. Assigning CONS between two = (CAR CONS) > > > > +=C2=A0 ;; prevents CSE. > > > > +=C2=A0 (assert-calls car 2 (cons other) > > > > +=C2=A0 =C2=A0 (declare (type cons cons other)) > > > > +=C2=A0 =C2=A0 (let ((a (car cons))) > > > > +=C2=A0 =C2=A0 =C2=A0 (setq cons other) > > > > +=C2=A0 =C2=A0 =C2=A0 (let ((b (car cons))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (list a b))))) > > > > + > > > > +(with-test (:name (:cse :setq-of-load-arg-prevents-cdr)) > > > > +=C2=A0 (assert-calls cdr 2 (cons other) > > > > +=C2=A0 =C2=A0 (declare (type cons cons other)) > > > > +=C2=A0 =C2=A0 (let ((a (cdr cons))) > > > > +=C2=A0 =C2=A0 =C2=A0 (setq cons other) > > > > +=C2=A0 =C2=A0 =C2=A0 (let ((b (cdr cons))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (list a b))))) > > > > + > > > > +(with-test (:name (:cse :setq-of-load-arg-prevents-instance-ref)) > > > > +=C2=A0 ;; Assigning the struct variable between two reads of the s= ame slot prevents CSE. > > > > +=C2=A0 (assert-calls sb-kernel:%instance-ref 2 (x y) > > > > +=C2=A0 =C2=A0 (let ((x (truly-the cse-test-foo x)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (y (truly-the cse-test-foo y))) > > > > +=C2=A0 =C2=A0 =C2=A0 (let ((a (cse-test-foo-slot x))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (setq x y) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (let ((b (cse-test-foo-slot x))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (list a b)))))) > > > > + > > > > +(with-test (:name (:cse :setq-of-load-arg-prevents-sap-ref)) > > > > +=C2=A0 ;; Assigning the SAP variable between two reads at the same= offset > > > > +=C2=A0 ;; must prevent CSE since the second read may use a differe= nt SAP. > > > > +=C2=A0 (assert-calls sb-sys:sap-ref-32 2 (sap1 sap2 offset) > > > > +=C2=A0 =C2=A0 (declare (type sb-sys:system-area-pointer sap1 sap2) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (type sb-vm:word offset)= ) > > > > +=C2=A0 =C2=A0 (let ((a (sb-sys:sap-ref-32 sap1 offset))) > > > > +=C2=A0 =C2=A0 =C2=A0 (setq sap1 sap2) > > > > +=C2=A0 =C2=A0 =C2=A0 (let ((b (sb-sys:sap-ref-32 sap1 offset))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (list a b))))) > > > > + > > > > +;;; SETQ of an *unrelated* variable should NOT prevent CSE. > > > > +;;; Only mutations of variables that participate in the load matte= r. > > > > +(with-test (:name (:cse :setq-of-unrelated-var-allows-cse)) > > > > +=C2=A0 ;; Z is not an argument to CAR, so setting Z does not inhib= it CSE. > > > > +=C2=A0 (assert-calls car 1 (cons z) > > > > +=C2=A0 =C2=A0 (declare (type cons cons)) > > > > +=C2=A0 =C2=A0 (let ((a (car cons))) > > > > +=C2=A0 =C2=A0 =C2=A0 (setq z a) > > > > +=C2=A0 =C2=A0 =C2=A0 (let ((b (car cons))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (list z b))))) > > > > + > > > > +;;; SB-THREAD:BARRIER of any kind prevents elision of the second l= oad > > > > +;;; since the memory barriers is not flushable. This is the conser= vative stance. > > > > +;;; The actual (looser) requirements are more subtle than I care t= o deal with. > > > > +(defmacro barrier-test (kind) > > > > +=C2=A0 `(with-test (:name (:cse :barrier-prevents-car ,kind)) > > > > +=C2=A0 =C2=A0 (assert-calls car 2 (cons) > > > > +=C2=A0 =C2=A0 =C2=A0 (declare (type cons cons)) > > > > +=C2=A0 =C2=A0 =C2=A0 (let ((a (car cons))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (sb-thread:barrier (,kind)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (let ((b (car cons))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (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 CS= E > > > > +;;; because the call may have side effects that modify the loaded = memory. > > > > + > > > > +(with-test (:name (:cse :non-flushable-call-prevents-cse)) > > > > +=C2=A0 ;; PRINC is a non-flushable > > > > +=C2=A0 (assert-calls car 2 (cons) > > > > +=C2=A0 =C2=A0 (declare (type cons cons)) > > > > +=C2=A0 =C2=A0 (let ((a (car cons))) > > > > +=C2=A0 =C2=A0 =C2=A0 (princ 42) > > > > +=C2=A0 =C2=A0 =C2=A0 (let ((b (car cons))) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (list a b))))) > > > > + > > > > +;;; Different functions on the same object are NOT considered comm= on subexpressions. > > > > +;;; (CAR x) and (CDR x) are different loads even if x is the same. > > > > +(with-test (:name (:cse :different-accessors-not-cse)) > > > > +=C2=A0 ;; Both CAR and CDR should appear, each exactly once. > > > > +=C2=A0 (assert-calls car 1 (cons) > > > > +=C2=A0 =C2=A0 (declare (type cons cons)) > > > > +=C2=A0 =C2=A0 (if (car cons) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (cdr cons)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 nil)) > > > > +=C2=A0 (assert-calls cdr 1 (cons) > > > > +=C2=A0 =C2=A0 (declare (type cons cons)) > > > > +=C2=A0 =C2=A0 (if (car cons) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 (princ (cdr cons)) > > > > +=C2=A0 =C2=A0 =C2=A0 =C2=A0 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 @@ > > > >=C2=A0 (#(10BE7277 12214AE8 12E2CBDA 19739539 1F3556C7 1F644387) > > > >=C2=A0 "(INTEGER BIGNUM SB-VM::UNSIGNED-BYTE-31 SB-VM::SIGNED-BYTE-3= 2 FIXNUM SB-VM::POSITIVE-FIXNUM)" > > > >=C2=A0 "((& (^ 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::CO= MBINATION SB-C::CIF)" > > > > + "((& (+ (>> val 1) (>> val 9)) 7))") > > > >=C2=A0 (#(10D2EA4E 1224C557 15A58D85 15B5A2B5 17524A78 1769E419 1890= 6D08 19577539 1C065CB8 1D66C932) > > > >=C2=A0 "#(((:TYPE SB-C::REF)) ((:TYPE SB-C::COMBINATION)) ((:TYPE SB= -C::CIF)) ((:TYPE SB-C::CRETURN)) ((:TYPE SB-C::MV-COMBINATION)) ((:TYPE EX= IT)) ((:TYPE SB-C::CSET)) ((:TYPE DELAY) (:TYPE SB-C::ARRAY-INDEX-CAST) (:T= YPE CAST)))" > > > >=C2=A0 "((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 @@ > > > >=C2=A0 (#(9A320D4 39CAA339 43BBEE18 4D61368F 53222DFB BFA86189 EDA10= 37F FEE99A95) > > > >=C2=A0 "#(((:TYPE SB-C::REF)) ((:TYPE SB-C::COMBINATION)) ((:TYPE SB= -C::MV-COMBINATION)) ((:TYPE EXIT)) ((:TYPE SB-C::CSET)) ((:TYPE DELAY) (:T= YPE SB-C::ARRAY-INDEX-CAST) (:TYPE CAST)))" > > > >=C2=A0 "((& (- (>> val 3) (>> val 29)) 7))") > > > > +(#(9A320D4 39CAA339 43BBEE18 53222DFB 9380837C BFA86189 FEE99A95) > > > > + "#(((:TYPE SB-C::CIF) (:TYPE SB-C::COMBINATION) (:TYPE DELAY) (:T= YPE SB-C::ARRAY-INDEX-CAST) (:TYPE CAST) (:TYPE SB-C::REF) (:TYPE SB-C::CSE= T)))" > > > > + "((& (+ val (>> val 31)) 7))") > > > >=C2=A0 (#(9A320D4 43BBEE18 53222DFB A8A4C7D2 BFA86189 EAA3DA5C FEE99= A95) > > > >=C2=A0 "#(((:TYPE SB-C::REF)) ((:TYPE DELAY) (:TYPE SB-C::ARRAY-INDE= X-CAST) (:TYPE CAST)) ((:TYPE SB-C::COMBINATION)) ((:TYPE SB-C::ENTRY)) ((:= TYPE SB-C::ENCLOSE)))" > > > >=C2=A0 "((& (^ (>> 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 @@ > > > >=C2=A0 (#(121068DD 4D61368F 58110E7F 67EE2D1A 6D9A883D 74589D82 897B= 4656 A68A3965) > > > >=C2=A0 "#(((:TYPE SB-C::REF)) ((:TYPE SB-C::COMBINATION)) ((:TYPE SB= -C::MV-COMBINATION)) ((:TYPE EXIT)) ((:TYPE SB-C::CSET)) ((:TYPE DELAY) (:T= YPE SB-C::ARRAY-INDEX-CAST) (:TYPE CAST)))" > > > >=C2=A0 "((& (- (>> val 4) (>> val 16)) 7))") > > > > +(#(121068DD 58110E7F 67EE2D1A 6D9A883D 742D4C54 897B4656 A68A3965) > > > > + "#(((:TYPE SB-C::CIF) (:TYPE SB-C::COMBINATION) (:TYPE DELAY) (:T= YPE SB-C::ARRAY-INDEX-CAST) (:TYPE CAST) (:TYPE SB-C::REF) (:TYPE SB-C::CSE= T)))" > > > > + "((& (- (>> val 4) (>> val 16)) 7))") > > > >=C2=A0 (#(126ADB02 31B095DD 42D83FFB 4341F7D8 63C971D7 7A80F201 7B40= 8880 8F7912D6 EBD01872) > > > >=C2=A0 "(:ALLOW-OTHER-KEYS :TYPE :RESULT-SPECS :ARG-SPECS :CALLER :D= EPS :FIRED :LEXENV :SOURCE-PATH)" > > > >=C2=A0 "((let ((tab #a((8) (unsigned-byte 8) 0 5 0 3 0 5 12 6))) > > > > > > > > -------------------------------------------------------------------= ---- > > > > > > > > > > > > hooks/post-receive > > > > -- > > > > SBCL > > > > > > > > > > > > _______________________________________________ > > > > Sbcl-commits mailing list > > > > [email protected] > > > > https://lists.sourceforge.net/lists/listinfo/sbcl-commits _______________________________________________ Sbcl-commits mailing list [email protected] https://lists.sourceforge.net/lists/listinfo/sbcl-commits ------=_Part_1714915_1527299352.1785838154448 Content-Type: text/html; charset=UTF-8 Content-Transfer-Encoding: quoted-printable <html xmlns=3D"http://www.w3.org/1999/xhtml" xmlns:v=3D"urn:schemas-microso= ft-com:vml" xmlns:o=3D"urn:schemas-microsoft-com:office:office"><head><!--[= if gte mso 9]><xml><o:OfficeDocumentSettings><o:AllowPNG/><o:PixelsPerInch>= 96</o:PixelsPerInch></o:OfficeDocumentSettings></xml><![endif]--></head><bo= dy> Wouldn=E2=80=99t this optimization be better off done in IR2? If we ar= e working hard to approximate what the vops and memory loads would end up d= oing.<div><br></div><div>Many advantages:</div><div><br></div><div>- Possib= le to estimate whether it would impact stack usage.</div><div>- Cost model = with register allocator possible</div><div>- Accurate vop costs</div><div>-= No shenanigans around different lambda representations</div><div>- TN= s are more amenable to value numbering.</div><div>- Environment analysis al= ready done.</div><div>- Ir1 optimizers not impacted</div><div>- Type checki= ng possible to CSE</div><div><br></div><div>Especially because local CSE do= es not trigger other front end optimizations or improve type inference.</di= v><div><br><p class=3D"yahoo-quoted-begin" style=3D"font-size: 15px; paddin= g-top: 15px; margin-top: 0">On Tuesday, August 4, 2026, 6:18 AM, Stas Bouka= rev <<span style=3D"color: rgb(var(--links-caret-color)) !important">sta= [email protected]</span>> wrote:</p><blockquote class=3D"iosymail"><div di= r=3D"ltr">(defun j2 (x n)<br></div><div dir=3D"ltr"> (declare (optimi= ze (debug 0)))<br></div><div dir=3D"ltr"> (let ((y (1+ x)))<br></div>= <div dir=3D"ltr"> (list (1+ (car n))<br></div><div dir=3D"ltr"= > (car n)<br></div><div dir=3D"ltr"> = ; (cdr n)<br></div><div dir=3D"ltr"> &nbs= p; y y)))<br></div><div dir=3D"ltr">increases stack us= age due to having to save the new shared variable on<br></div><div dir=3D"l= tr">the stack.<br></div><div dir=3D"ltr"><br></div><div dir=3D"ltr">On Tue,= Aug 4, 2026 at 7:04=E2=80=AFAM Stas Boukarev <<a ymailto=3D"mailto:stas= [email protected]" href=3D"mailto:[email protected]">[email protected]</a>&g= t; wrote:<br></div><div dir=3D"ltr">><br></div><div dir=3D"ltr">> (de= fun k (x n)<br></div><div dir=3D"ltr">> (let ((y (1+ x)))<br></di= v><div dir=3D"ltr">> (values y y<br></div><div dir=3D"ltr"= >> (eq (car (copy-tree n))<br>= </div><div dir=3D"ltr">> = (car (copy-tree n))))))<br></div><div dir=3D"ltr">> =3D><br>= </div><div dir=3D"ltr">> (k 1 '((1)))<br></div><div dir=3D"ltr">> =3D= ><br></div><div dir=3D"ltr">> 2<br></div><div dir=3D"ltr">> 2<br><= /div><div dir=3D"ltr">> T<br></div><div dir=3D"ltr">><br></div><div d= ir=3D"ltr">> On Tue, Aug 4, 2026 at 6:47=E2=80=AFAM Stas Boukarev <<a= ymailto=3D"mailto:[email protected]" href=3D"mailto:[email protected]">s= [email protected]</a>> wrote:<br></div><div dir=3D"ltr">> ><br></d= iv><div dir=3D"ltr">> > (defun j (x)<br></div><div dir=3D"ltr">> &= gt; (let ((y (1+ x)))<br></div><div dir=3D"ltr">> > &nbs= p; (values y y<br></div><div dir=3D"ltr">> > &nb= sp; (car *)<br></div><div dir=3D"ltr">> > = (setf * '(b))<br></div><div dir=3D"ltr">> = > (car *))))<br></div><div dir= =3D"ltr">> > (let ((* '(a))) (j 1))<br></div><div dir=3D"ltr">> &g= t; =3D><br></div><div dir=3D"ltr">> > 2<br></div><div dir=3D"ltr">= > > 2<br></div><div dir=3D"ltr">> > A<br></div><div dir=3D"ltr"= >> > (B)<br></div><div dir=3D"ltr">> > A<br></div><div dir=3D"l= tr">> ><br></div><div dir=3D"ltr">> > On Tue, Aug 4, 2026 at 4:= 22=E2=80=AFAM Stas Boukarev <<a ymailto=3D"mailto:[email protected]" hr= ef=3D"mailto:[email protected]">[email protected]</a>> wrote:<br></div= ><div dir=3D"ltr">> > ><br></div><div dir=3D"ltr">> > > (= defstruct s<br></div><div dir=3D"ltr">> > > (x (make-array = 3)))<br></div><div dir=3D"ltr">> > ><br></div><div dir=3D"ltr">>= ; > > (let (*)<br></div><div dir=3D"ltr">> > > (lambd= a ()<br></div><div dir=3D"ltr">> > > (let* ((s #.(ma= ke-s))<br></div><div dir=3D"ltr">> > > = (a (s-x s))<br></div><div dir=3D"ltr">> > > &n= bsp; (b (s-x s)))<br></div><div dir=3D"ltr">>= ; > > (values (aref a 0)<br></div><div dir=3D"lt= r">> > > (aref b = 0)))))<br></div><div dir=3D"ltr">> > ><br></div><div dir=3D"ltr">&= gt; > ><br></div><div dir=3D"ltr">> > > debugger invoked on = a SB-INT:BUG @B8007B85AD in thread<br></div><div dir=3D"ltr">> > >= #<THREAD tid=3D1986402 "main thread" RUNNING {12014F0003}>:<br></div= ><div dir=3D"ltr">> > > failed AVER: (EQ ENV (LAMBDA= -ENVIRONMENT (LAMBDA-VAR-HOME THING)))<br></div><div dir=3D"ltr">> > = ><br></div><div dir=3D"ltr">> > > On Tue, Aug 4, 2026 at 3:59= =E2=80=AFAM snuglas via Sbcl-commits<br></div><div dir=3D"ltr">> > &g= t; <<a ymailto=3D"mailto:[email protected]" href=3D"mai= lto:[email protected]">[email protected]<= /a>> wrote:<br></div><div dir=3D"ltr">> > > ><br></div><div = dir=3D"ltr">> > > > The branch "master" has been updated in SBC= L:<br></div><div dir=3D"ltr">> > > > = via 100c9c2bdcdcb84ff04c8feef983a5b44695c97a (commit)<br></div><div = dir=3D"ltr">> > > > from b541f2f25b1= 4b62fcab7e14aa5124db5dd1d6b20 (commit)<br></div><div dir=3D"ltr">> > = > ><br></div><div dir=3D"ltr">> > > > - Log -------------= ----------------------------------------------------<br></div><div dir=3D"l= tr">> > > > commit 100c9c2bdcdcb84ff04c8feef983a5b44695c97a<br>= </div><div dir=3D"ltr">> > > > Author: Douglas Katzman <<a y= mailto=3D"mailto:[email protected]" href=3D"mailto:[email protected]">dougk@g= oogle.com</a>><br></div><div dir=3D"ltr">> > > > Date: = Tue Aug 4 00:58:21 2026 +0000<br></div><div dir=3D"ltr">> > > &g= t;<br></div><div dir=3D"ltr">> > > > Perform loca= l common subexpression elimination for some memory loads<br></div><div dir= =3D"ltr">> > > ><br></div><div dir=3D"ltr">> > > >&= nbsp; The technique is to find "equivalent" loads in between which = there is no<br></div><div dir=3D"ltr">> > > > com= putation that affects the result of the load. Also it needs a surrounding<b= r></div><div dir=3D"ltr">> > > > LET, which is au= gmented with a new temp variable as if the user did that.<br></div><div dir= =3D"ltr">> > > > This is slightly deficient for v= arious reasons:<br></div><div dir=3D"ltr">> > > > = 1. it won't do anything without the LET<br></div><div dir=3D"ltr">> >= ; > > 2. the more kinds of common subexpressions we all= ow (such as math),<br></div><div dir=3D"ltr">> > > > &nbs= p; the slower IR1-OPTIMIZE-COMBINATION is going to run<br></d= iv><div dir=3D"ltr">> > > > 3. there are possibly= other node types that should be allowed to intervene<br></div><div dir=3D"= ltr">> > > ><br></div><div dir=3D"ltr">> > > > = ; On the plus side, it's not all that hard to extend the logic to a= ccept<br></div><div dir=3D"ltr">> > > > other fun= ctions as participants in common subexpressions.<br></div><div dir=3D"ltr">= > > > ><br></div><div dir=3D"ltr">> > > > &nb= sp; All test cases plus a little bit of assistance from Gemini<br></div><d= iv dir=3D"ltr">> > > > ---<br></div><div dir=3D"ltr">> > = > > src/compiler/ir1opt.lisp | 179 ++++++++++++++++++++++++++++= ++++++++<br></div><div dir=3D"ltr">> > > > tests/lcse.pur= e.lisp | 234 +++++++++++++++++++++++++++++++++++++++++++++++<= br></div><div dir=3D"ltr">> > > > xperfecthash30.lisp-exp= r | 3 +<br></div><div dir=3D"ltr">> > > > xperfect= hash61.lisp-expr | 3 +<br></div><div dir=3D"ltr">> > > >= xperfecthash63.lisp-expr | 3 +<br></div><div dir=3D"ltr">>= > > > 5 files changed, 422 insertions(+)<br></div><div dir= =3D"ltr">> > > ><br></div><div dir=3D"ltr">> > > > = diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp<br></div><= div dir=3D"ltr">> > > > index 8559824f1..dac393e31 100644<br></= div><div dir=3D"ltr">> > > > --- a/src/compiler/ir1opt.lisp<br>= </div><div dir=3D"ltr">> > > > +++ b/src/compiler/ir1opt.lisp<b= r></div><div dir=3D"ltr">> > > > @@ -1220,6 +1220,182 @@<br></d= iv><div dir=3D"ltr">> > > > &= nbsp; (show-type-derivation combination res))<br></div><div dir=3D"l= tr">> > > > (coerce-to= -values res))))))<br></div><div dir=3D"ltr">> > > ><br></div><d= iv dir=3D"ltr">> > > > +(defun collect-lvar-vars (lvar)<br></di= v><div dir=3D"ltr">> > > > + (declare (type lvar lvar))<b= r></div><div dir=3D"ltr">> > > > + (let ((use (principal-= lvar-use lvar)))<br></div><div dir=3D"ltr">> > > > + &nbs= p; (cond ((ref-p use)<br></div><div dir=3D"ltr">> > > > + = (let ((leaf (ref-leaf use)))<br></div><div di= r=3D"ltr">> > > > + (= when (lambda-var-p leaf)<br></div><div dir=3D"ltr">> > > > +&nb= sp; (list leaf))))<br></div><div= dir=3D"ltr">> > > > + ((comb= ination-p use)<br></div><div dir=3D"ltr">> > > > + = (mapcan #'collect-lvar-vars (basic-combination-args = use)))<br></div><div dir=3D"ltr">> > > > + = (t nil))))<br></div><div dir=3D"ltr">> > > > +<br= ></div><div dir=3D"ltr">> > > > +(defun find-active-let-lambda = (node)<br></div><div dir=3D"ltr">> > > > + (declare (type= node node))<br></div><div dir=3D"ltr">> > > > + (loop fo= r env =3D (node-lexenv node) then (lexenv-parent env)<br></div><div dir=3D"= ltr">> > > > + while env<br></div><d= iv dir=3D"ltr">> > > > + do (let ((l= (lexenv-lambda env)))<br></div><div dir=3D"ltr">> > > > + = ; (when (and l<br></div><div dir=3D"ltr= ">> > > > + &nb= sp; (functional-kind-eq l let)<br></div><div di= r=3D"ltr">> > > > + &n= bsp; (not (functional-kind-eq l zombie))= )<br></div><div dir=3D"ltr">> > > > +  = ; (return l)))))<br></div><div dir=3D"ltr">> > = > > +<br></div><div dir=3D"ltr">> > > > +(defun add-varia= ble-to-let-lambda (let-lambda v)<br></div><div dir=3D"ltr">> > > &= gt; + (declare (type clambda let-lambda)<br></div><div dir=3D"ltr">&g= t; > > > + (type lambda-var v))= <br></div><div dir=3D"ltr">> > > > + (setf (lambda-var-ho= me v) let-lambda)<br></div><div dir=3D"ltr">> > > > + (se= tf (lambda-vars let-lambda) (append (lambda-vars let-lambda) (list v)))<br>= </div><div dir=3D"ltr">> > > > + ;; Update the call to th= e LET lambda<br></div><div dir=3D"ltr">> > > > + (let* ((= ref (car (leaf-refs let-lambda)))<br></div><div dir=3D"ltr">> > > = > + (call (and ref<br></div><div dir=3D"ltr"= >> > > > + &nbs= p; (node-lvar ref)<br></div><div dir=3D"ltr">> > > &= gt; + = (lvar-dest (node-lvar ref)))))<br></div><div dir=3D"ltr">> > > >= ; + (when (and call (combination-p call))<br></div><div dir=3D= "ltr">> > > > + (let ((dummy-lvar (make-lva= r)))<br></div><div dir=3D"ltr">> > > > + &n= bsp; (setf (lvar-dest dummy-lvar) call)<br></div><div dir=3D"ltr">> >= > > + (setf (basic-combination-args call)= <br></div><div dir=3D"ltr">> > > > + = (append (basic-combination-args call) (list dummy-lva= r)))<br></div><div dir=3D"ltr">> > > > + &n= bsp; (setf (lvar-dest dummy-lvar) call)))))<br></div><div dir=3D"ltr">> = > > > +<br></div><div dir=3D"ltr">> > > > +;; Reuse of= SYMBOL-VALUE of a special var would be nice,<br></div><div dir=3D"ltr">>= ; > > > +;; but SYMBOL-VALUE it is not represented as a call in IR= 1<br></div><div dir=3D"ltr">> > > > +(define-load-time-global *= elidable-memory-loads*<br></div><div dir=3D"ltr">> > > > + = ; '(car cdr %instance-ref %raw-instance-ref/word %raw-instance-ref/s= igned-word<br></div><div dir=3D"ltr">> > > > + &nb= sp; sap-ref-16 signed-sap-ref-16 sb-sys::%sap-ref-16-indexed sb-sys::%signe= d-sap-ref-16-indexed<br></div><div dir=3D"ltr">> > > > + = sap-ref-32 signed-sap-ref-32 sb-sys::%sap-ref-32-indexed sb-s= ys::%signed-sap-ref-32-indexed<br></div><div dir=3D"ltr">> > > >= ; + sap-ref-64 signed-sap-ref-64 sb-sys::%sap-ref-64-in= dexed sb-sys::%signed-sap-ref-64-indexed<br></div><div dir=3D"ltr">> >= ; > > + sb-alien:deref<br></div><div dir=3D"ltr">= > > > > + sb-alien:alien-sap))<br></div><di= v dir=3D"ltr">> > > > +<br></div><div dir=3D"ltr">> > >= ; > +;;; Look for any node equivalent to MATCH consdering nodes in rever= se starting at FROM.<br></div><div dir=3D"ltr">> > > > +;;; Mem= ory loads from the same object+slot or SAP+offset could be equivalent.<br><= /div><div dir=3D"ltr">> > > > +;;; Nothing else can be equivale= nt (until I enhance this)<br></div><div dir=3D"ltr">> > > > +(d= efun find-equivalent-node-backwards (match from)<br></div><div dir=3D"ltr">= > > > > + (labels ((lvar-equivalent-p (l1 l2)<br></div><d= iv dir=3D"ltr">> > > > + &nbs= p; (declare (type lvar l1 l2))<br></div><div dir=3D"ltr">> > > &g= t; + (cond ((eq l1 l2) t)<br></di= v><div dir=3D"ltr">> > > > + = ((and (constant-lvar-p l1) (constant-lvar-p l2= ))<br></div><div dir=3D"ltr">> > > > + &nbs= p; (eql (lvar-value l1) (lvar-val= ue l2)))<br></div><div dir=3D"ltr">> > > > +  = ; (t<br></div><div dir=3D"ltr">&= gt; > > > + = (let ((u1 (principal-lvar-use l1))<br></div><div dir=3D"ltr"= >> > > > + &nbs= p; (u2 (principal-lvar-use l2)))<br></di= v><div dir=3D"ltr">> > > > + = (cond ((and (ref-p u1) (ref-p u2)= )<br></div><div dir=3D"ltr">> > > > +  = ; (e= q (ref-leaf u1) (ref-leaf u2)))<br></div><div dir=3D"ltr">> > > &g= t; + &= nbsp; ((and (combination-p u1) (combination-p u2)<br><= /div><div dir=3D"ltr">> > > > + &nbs= p; &n= bsp; (eq (basic-combination-kind u1) :known)<br></div><div dir=3D"lt= r">> > > > + &n= bsp; (eq (ba= sic-combination-kind u2) :known))<br></div><div dir=3D"ltr">> > > = > + = (combination-equivalent-p u1 u2))<br></div><d= iv dir=3D"ltr">> > > > + &nbs= p; (t nil))))))<br>= </div><div dir=3D"ltr">> > > > + &nb= sp; (combination-equivalent-p (c1 c2)<br></div><div dir=3D"ltr">> > = > > + (declare (type combin= ation c1 c2))<br></div><div dir=3D"ltr">> > > > + = (and (eq (basic-combination-fun-info c1) (basi= c-combination-fun-info c2))<br></div><div dir=3D"ltr">> > > > += (let ((args1= (basic-combination-args c1))<br></div><div dir=3D"ltr">> > > >= + &nb= sp; (args2 (basic-combination-args c2)))<br></div><div dir=3D"ltr">&= gt; > > > + = (and (=3D (length args1) (length args2))<br></div><div dir= =3D"ltr">> > > > + &nb= sp; (every #'lvar-equivalent-p args1 ar= gs2))))))<br></div><div dir=3D"ltr">> > > > + (do = ((node from (ctran-use (node-prev node)))) ((null node))<br></div><div dir= =3D"ltr">> > > > + (when (and (combination-= p node)<br></div><div dir=3D"ltr">> > > > + = (eq (combination-kind node) :known)<br= ></div><div dir=3D"ltr">> > > > + &n= bsp; (node-lvar node)<br></div><div dir=3D"ltr">> = > > > + (c= ombination-equivalent-p node match))<br></div><div dir=3D"ltr">> > &g= t; > + (return node))<br></div><div dir=3D"lt= r">> > > > + (typecase node<br></div><div d= ir=3D"ltr">> > > > + ((or cset ref c= ast combination cif))<br></div><div dir=3D"ltr">> > > > + = (t<br></div><div dir=3D"ltr">> > > > +&nb= sp; ;; Return :FAIL to abort quickly. This could choo= se to fail if a non-flushable<br></div><div dir=3D"ltr">> > > >= + ;; combination is seen, but for now I'm defe= rring that soundness check.<br></div><div dir=3D"ltr">> > > > += (return-from find-equivalent-node-backwards :f= ail))))))<br></div><div dir=3D"ltr">> > > > +<br></div><div dir= =3D"ltr">> > > > +;;; Attmpt to find a COMBINATION equivalent t= o THIS preceding it in node order, the value<br></div><div dir=3D"ltr">>= > > > +;;; of which can be substituted for the call to THIS, actu= ally making the substitution.<br></div><div dir=3D"ltr">> > > >= +;;; Looking backwards at most a few blocks tends to work well enough, and= inportantly<br></div><div dir=3D"ltr">> > > > +;;; limits the = work. Scanning only the current block is inadequate as the example<br></div= ><div dir=3D"ltr">> > > > +;;; in :LOOP-OVER-DEREF shows. The i= mmediate predecessor is still not enough, because the<br></div><div dir=3D"= ltr">> > > > +;;; predecessor could have been split, leaving a = tiny block where the only node is<br></div><div dir=3D"ltr">> > > = > +;;; a trivial operation.<br></div><div dir=3D"ltr">> > > >= ; +(defun try-reuse-expr-value (this)<br></div><div dir=3D"ltr">> > &= gt; > + (declare (type combination this))<br></div><div dir=3D"ltr= ">> > > > + (binding*<br></div><div dir=3D"ltr">> >= > > + ((home-lambda (find-active-let-lambda this= ) :exit-if-null)<br></div><div dir=3D"ltr">> > > > + &nbs= p; (lookback 0)<br></div><div dir=3D"ltr">> > > > +&nbs= p; (c1<br></div><div dir=3D"ltr">> > > > + = ;; In this block, explicitly go back a node so that F= IND-BACKWARDS doesn't consider THIS<br></div><div dir=3D"ltr">> > >= ; > + ;; as equivalent to itself. Failing tha= t, try predecessor blocks, but only as long as<br></div><div dir=3D"ltr">&g= t; > > > + ;; pred is unique since we h= ave no information about nodes that dominate THIS.<br></div><div dir=3D"ltr= ">> > > > + (or (find-equivalent-nod= e-backwards this (ctran-use (node-prev this)))<br></div><div dir=3D"ltr">&g= t; > > > + (do ((pred (bl= ock-pred (node-block this))))<br></div><div dir=3D"ltr">> > > >= + ((or (> lookba= ck 3) (not (singleton-p pred))))<br></div><div dir=3D"ltr">> > > &= gt; + (incf lookback)<br></= div><div dir=3D"ltr">> > > > +  = ; (let ((node (block-last (car pred))))<br></div><div dir=3D"= ltr">> > > > + = (when (null node) (return))<br></div><div dir=3D"ltr">> > >= > + (awhen (find= -equivalent-node-backwards this node) (return it))<br></div><div dir=3D"ltr= ">> > > > + &nb= sp; (setq pred (block-pred (node-block node))))))<br></div><div dir=3D"ltr"= >> > > > + :exit-if-null)<br></div><= div dir=3D"ltr">> > > > + (vars ; can't us= e :exit-if-null here because VARS can be and usually is NIL<br></div><div d= ir=3D"ltr">> > > > + (unless (eq c1 = :fail)<br></div><div dir=3D"ltr">> > > > + = (mapcan #'collect-lvar-vars (basic-combination-args c1)))))<b= r></div><div dir=3D"ltr">> > > > + (when (eq c1 :f= ail)<br></div><div dir=3D"ltr">> > > > + (r= eturn-from try-reuse-expr-value nil))<br></div><div dir=3D"ltr">> > &= gt; > + (labels ((all-flushable (ctran end-node)<br></div><= div dir=3D"ltr">> > > > + &nb= sp; (declare (ctran ctran) (type (or node null) end-node))<br></div= ><div dir=3D"ltr">> > > > + &= nbsp; (loop (let ((node (ctran-next ctran)))<br></div><div dir=3D"l= tr">> > > > + &= nbsp; (cond ((eq node end-node) (return t))<br></div>= <div dir=3D"ltr">> > > > + &n= bsp; ((not (ok-to-= flush node)) (return nil))<br></div><div dir=3D"ltr">> > > > +&= nbsp; = ((and (not end-node) (not (node-next node))) (return= t)))<br></div><div dir=3D"ltr">> > > > + &= nbsp; (setq ctran (node-n= ext node)))))<br></div><div dir=3D"ltr">> > > > + = (ok-to-flush (node)<br></div><div dir=3D"ltr">= > > > > + (con= d ((set-p node) (not (member (set-var node) vars)))<br></div><div dir=3D"lt= r">> > > > + &n= bsp; ((combination-p node) (flushable-combination-p node))<b= r></div><div dir=3D"ltr">> > > > + &= nbsp; ((basic-combination-p node) nil)<= br></div><div dir=3D"ltr">> > > > + = (t t)))) ; anything else the bac= kwards search allowed is ok<br></div><div dir=3D"ltr">> > > > += ;; When lookback>0 it's possible for the equivalent= node to be the final node<br></div><div dir=3D"ltr">> > > > +&= nbsp; ;; of its block, in which case its NODE-NEXT is null.<b= r></div><div dir=3D"ltr">> > > > + (let* ((= this-block (node-block this))<br></div><div dir=3D"ltr">> > > >= + (pred (car (block-pred this-bl= ock))))<br></div><div dir=3D"ltr">> > > > + = (unless (if (=3D lookback 0)<br></div><div dir=3D"ltr">> > &g= t; > + &nb= sp; (all-flushable (node-next c1) this)<br></div><div dir=3D"ltr">> >= > > + = (and<br></div><div dir=3D"ltr">> > > > + &n= bsp; ;; Check prev block = from C1 to its end of block, and current block up to THIS<br></div><div dir= =3D"ltr">> > > > + &nb= sp; (acond ((node-next c1) (all-flushable it nil)) (t= t))<br></div><div dir=3D"ltr">> > > > + &n= bsp; (all-flushable (block-start= this-block) this)<br></div><div dir=3D"ltr">> > > > + &n= bsp; ;; All check = all of one or both intervening blocks<br></div><div dir=3D"ltr">> > &= gt; > + &n= bsp; (or (< lookback 2)<br></div><div dir=3D"ltr">> > > > +=  = ; (all-flushable (block-start pred) nil))<br></div><div dir=3D"ltr"= >> > > > + &nbs= p; (or (< lookback 3)<br></div><div dir=3D"ltr">> >= > > + = (all-flushable (block-start (car (block-pred pred))) = nil))))<br></div><div dir=3D"ltr">> > > > + = (return-from try-reuse-expr-value nil))))<br></div><div dir= =3D"ltr">> > > > + ;; Substitute C1's result in fo= r THIS<br></div><div dir=3D"ltr">> > > > + (bindin= g* ((lvar-c1 (node-lvar c1) :exit-if-null)<br></div><div dir=3D"ltr">> &= gt; > > + (consumer-= 1 (lvar-dest lvar-c1) :exit-if-null)<br></div><div dir=3D"ltr">> > &g= t; > + (c2 this)<br></d= iv><div dir=3D"ltr">> > > > + = (lvar-c2 (node-lvar c2) :exit-if-null)<br></div><div dir=3D= "ltr">> > > > + = (v (make-lambda-var (gensym "REUSED-VAL")<br></div><div dir=3D"ltr">> = > > > + &nb= sp; :type (single-= value-type (node-derived-type c1))))<br></div><div dir=3D"ltr">> > &g= t; > + (lvar-new (make-= lvar)))<br></div><div dir=3D"ltr">> > > > + = (add-variable-to-let-lambda home-lambda v)<br></div><div dir=3D"ltr">> = > > > +<br></div><div dir=3D"ltr">> > > > + &nbs= p; ;; 1. Redirect consumer-1 to read from lvar-new<br></div><div dir= =3D"ltr">> > > > + (substitute-lvar lvar-ne= w lvar-c1)<br></div><div dir=3D"ltr">> > > > +<br></div><div di= r=3D"ltr">> > > > + (with-ir1-environment-f= rom-node c1<br></div><div dir=3D"ltr">> > > > + &n= bsp; ;; 2. Make C1 write to a new LVAR, and link it to a CSET on V<b= r></div><div dir=3D"ltr">> > > > + (= let ((lvar-c1-new (make-lvar)))<br></div><div dir=3D"ltr">> > > &g= t; + (%delete-lvar-use c1)<br></div><div = dir=3D"ltr">> > > > + (use-lv= ar c1 lvar-c1-new)<br></div><div dir=3D"ltr">> > > > + &n= bsp; ;; 3. Create S1 (set V =3D lvar-c1-new) and inser= t after C1<br></div><div dir=3D"ltr">> > > > + &nb= sp; (let ((s1 (make-set v lvar-c1-new)))<br></div><div dir=3D= "ltr">> > > > + (setf = (lvar-dest lvar-c1-new) s1)<br></div><div dir=3D"ltr">> > > > += (push s1 (basic-var-sets v))<br><= /div><div dir=3D"ltr">> > > > + &nbs= p; (insert-node-after c1 s1))))<br></div><div dir=3D"ltr">> > = > > +<br></div><div dir=3D"ltr">> > > > + &n= bsp; ;; 4. Insert ref1 before consumer-1, writing to lvar-new<br></div><div= dir=3D"ltr">> > > > + (insert-ref-before v= consumer-1 lvar-new)<br></div><div dir=3D"ltr">> > > > + = ;; 5. Insert ref2 before C2, stealing C2's lvar<br></div><di= v dir=3D"ltr">> > > > + (insert-ref-before = v c2 t)<br></div><div dir=3D"ltr">> > > > + = ;; C2 is now dead and will be flushed by the caller!<br></div><div dir=3D"= ltr">> > > > + t)))<br></div><div dir=3D"lt= r">> > > > +<br></div><div dir=3D"ltr">> > > > = ; ;;; Do IR1 optimizations on a COMBINATION node.<br></div><div dir=3D"ltr"= >> > > > (defun ir1-optimize-combination (node &aux (= show *show-transforms-p*))<br></div><div dir=3D"ltr">> > > >&nb= sp; (declare (type combination node))<br></div><div dir=3D"ltr">>= > > > @@ -1305,6 +1481,9 @@<br></div><div dir=3D"ltr">> > &= gt; > &nbs= p; (not (node-lvar node)))<br></div><div dir=3D"ltr">> &g= t; > > = (return-from ir1-optimize-combination (flush-node node)))<br></div><= div dir=3D"ltr">> > > >  = ; ((fold-call-derived-to-constant node)<br></div><div= dir=3D"ltr">> > > > + = (return-from ir1-optimize-combination))<br></div><div= dir=3D"ltr">> > > > + = ((and (combination-is node *elidable-memory-loads*)<br></di= v><div dir=3D"ltr">> > > > + = (try-reuse-expr-value node))<br>= </div><div dir=3D"ltr">> > > >  = ; (return-from ir1-optimize-combination)= ))<br></div><div dir=3D"ltr">> > > > = (when (and (ir1-attributep (fun-info-attributes info) commu= tative)<br></div><div dir=3D"ltr">> > > > &= nbsp; (=3D (length = args) 2)<br></div><div dir=3D"ltr">> > > > diff --git a/tests/l= cse.pure.lisp b/tests/lcse.pure.lisp<br></div><div dir=3D"ltr">> > &g= t; > new file mode 100644<br></div><div dir=3D"ltr">> > > > = index 000000000..43b34e998<br></div><div dir=3D"ltr">> > > > --= - /dev/null<br></div><div dir=3D"ltr">> > > > +++ b/tests/lcse.= pure.lisp<br></div><div dir=3D"ltr">> > > > @@ -0,0 +1,234 @@<b= r></div><div dir=3D"ltr">> > > > +;;;; This software is part of= the SBCL system. See the README file for<br></div><div dir=3D"ltr">> &g= t; > > +;;;; more information.<br></div><div dir=3D"ltr">> > &g= t; > +;;;;<br></div><div dir=3D"ltr">> > > > +;;;; While mos= t of SBCL is derived from the CMU CL system, the test<br></div><div dir=3D"= ltr">> > > > +;;;; files (like this one) were written from scra= tch after the fork<br></div><div dir=3D"ltr">> > > > +;;;; from= CMU CL.<br></div><div dir=3D"ltr">> > > > +;;;;<br></div><div = dir=3D"ltr">> > > > +;;;; This software is in the public domain= and is provided with<br></div><div dir=3D"ltr">> > > > +;;;; a= bsolutely no warranty. See the COPYING and CREDITS files for<br></div><div = dir=3D"ltr">> > > > +;;;; more information.<br></div><div dir= =3D"ltr">> > > > +<br></div><div dir=3D"ltr">> > > >= ; +;;;; Tests of local common subexpression elimination<br></div><div dir= =3D"ltr">> > > > +<br></div><div dir=3D"ltr">> > > >= ; +(import '(ctu:inspect-ir<br></div><div dir=3D"ltr">> > > > += sb-c::combination-fun-debug-name<br></di= v><div dir=3D"ltr">> > > > + = sb-c::basic-combination-p))<br></div><div dir=3D"ltr">> > > > += <br></div><div dir=3D"ltr">> > > > +(defun ir-calls (form)<br><= /div><div dir=3D"ltr">> > > > + (let (calls)<br></div><di= v dir=3D"ltr">> > > > + (inspect-ir<br></div><div = dir=3D"ltr">> > > > + form<br></div><div dir=3D"l= tr">> > > > + (lambda (component)<br></div><div d= ir=3D"ltr">> > > > + (ctu:do-blocks (block= component)<br></div><div dir=3D"ltr">> > > > + &n= bsp; (ctu:do-nodes (node nil block)<br></div><div dir=3D"ltr">> = > > > + (when (basic-combinatio= n-p node)<br></div><div dir=3D"ltr">> > > > + &nbs= p; (push node calls))))))<br></div><div dir=3D"ltr">&= gt; > > > + calls))<br></div><div dir=3D"ltr">> &g= t; > > +<br></div><div dir=3D"ltr">> > > > +(defmacro ass= ert-calls (fun-name expected-count (&rest lambda-args) &body body)<= br></div><div dir=3D"ltr">> > > > + (sb-int:binding*<br><= /div><div dir=3D"ltr">> > > > + (((forms de= cls) (sb-int:parse-body body nil))<br></div><div dir=3D"ltr">> > >= > + (lexpr `(lambda (,@lambda-args)<br></div><div = dir=3D"ltr">> > > > + = ,@decls<br></div><div dir=3D"ltr">> > > > + = ; ;; Without a cont= aining LET form, the current implementation of CSE<br></div><div dir=3D"ltr= ">> > > > + &nb= sp; ;; is unwilling to bind a temporary lambda var for reuse.<br></d= iv><div dir=3D"ltr">> > > > + = (let ((active-let-var 0))<br></div><div dir=3D= "ltr">> > > > + = (print active-let-var)<br></div><div dir=3D"ltr">>= > > > + &n= bsp; (incf active-let-var (random 5))<br></div><div dir=3D"ltr">>= > > > + &n= bsp; (print active-let-var)<br></div><div dir=3D"ltr">> > >= > +  = ; ,@forms))))<br></div><div dir=3D"ltr">> > > > + = `(assert (=3D (count ',fun-name (ir-calls ',lexpr) :key #'combination-fun-d= ebug-name)<br></div><div dir=3D"ltr">> > > > + &nb= sp; ,expected-count))))<br></div><div di= r=3D"ltr">> > > > +<br></div><div dir=3D"ltr">> > > &g= t; +;;; Basic tests: a sampling of elidable load type with two identical lo= ads<br></div><div dir=3D"ltr">> > > > +<br></div><div dir=3D"lt= r">> > > > +(with-test (:name (:cse :car))<br></div><div dir=3D= "ltr">> > > > + (assert-calls car 1 (cons)<br></div><div = dir=3D"ltr">> > > > + (declare (type cons cons))<b= r></div><div dir=3D"ltr">> > > > + (if (car cons)<= br></div><div dir=3D"ltr">> > > > + = (princ (car cons))<br></div><div dir=3D"ltr">> > > > + &n= bsp; (princ (cdr cons)))))<br></div><div dir=3D"ltr">> >= ; > > +<br></div><div dir=3D"ltr">> > > > +(with-test (:n= ame (:cse :different-names-for-same-object))<br></div><div dir=3D"ltr">>= > > > + ;; Y and X refer to the same thing, and it doesn't = matter<br></div><div dir=3D"ltr">> > > > + ;; whose CDR w= e take first. Only one CDR operation is performed<br></div><div dir=3D"ltr"= >> > > > + (assert-calls cdr 1 (x)<br></div><div dir=3D"l= tr">> > > > + (declare (type cons x))<br></div><di= v dir=3D"ltr">> > > > + (let ((y x))<br></div><div= dir=3D"ltr">> > > > + (list (cdr y) (cdr x= ))))<br></div><div dir=3D"ltr">> > > > + (assert-calls cd= r 1 (x)<br></div><div dir=3D"ltr">> > > > + (decla= re (type cons x))<br></div><div dir=3D"ltr">> > > > + &nb= sp; (let ((y x))<br></div><div dir=3D"ltr">> > > > + &nbs= p; (list (cdr x) (cdr y)))))<br></div><div dir=3D"ltr">> > >= ; > +<br></div><div dir=3D"ltr">> > > > +(with-test (:name (= :cse :composition-of-cxr))<br></div><div dir=3D"ltr">> > > > +&= nbsp; ;; The CAR extraction which is part of the CDAR function can be<br></= div><div dir=3D"ltr">> > > > + ;; reused based on the fac= t that we evaluated (LISTP (CAR X))<br></div><div dir=3D"ltr">> > >= ; > + (assert-calls car 1 (x)<br></div><div dir=3D"ltr">> > = > > + (if (listp (car x)) (cdar x)))<br></div><div dir= =3D"ltr">> > > > + ;; negative test - CDAR on a different= Y is another CAR operation<br></div><div dir=3D"ltr">> > > > += (assert-calls car 2 (x y)<br></div><div dir=3D"ltr">> > > &= gt; + (if (listp (car x)) (cdar y))))<br></div><div dir=3D"ltr= ">> > > > +<br></div><div dir=3D"ltr">> > > > +(def= struct cse-test-foo slot (wslot 0 :type sb-vm:word))<br></div><div dir=3D"l= tr">> > > > +(with-test (:name (:cse :instance-ref))<br></div><= div dir=3D"ltr">> > > > + (assert-calls sb-kernel:%instan= ce-ref 1 (x)<br></div><div dir=3D"ltr">> > > > + ;= ; Depending on what TRANSFORM-INSTANCE-TYPEP does, it might access instance= -layout<br></div><div dir=3D"ltr">> > > > + ;; usi= ng %INSTANCE-REF which would have to be discounted in the call counting.<br= ></div><div dir=3D"ltr">> > > > + ;; Just brute-fo= rce the type to avoid that situation.<br></div><div dir=3D"ltr">> > &= gt; > + (let ((x (truly-the cse-test-foo x)))<br></div><div= dir=3D"ltr">> > > > + (if (cse-test-foo-sl= ot x)<br></div><div dir=3D"ltr">> > > > + &= nbsp; (princ (cse-test-foo-slot x))<br></div><div dir=3D"ltr">> &= gt; > > + nil))))<br></div><div dir= =3D"ltr">> > > > +<br></div><div dir=3D"ltr">> > > >= ; +(with-test (:name (:cse :raw-instance-ref/word))<br></div><div dir=3D"lt= r">> > > > + (assert-calls sb-kernel:%raw-instance-ref/wo= rd 1 (x)<br></div><div dir=3D"ltr">> > > > + (decl= are (type cse-test-foo x))<br></div><div dir=3D"ltr">> > > > +&= nbsp; (if (logtest (cse-test-foo-wslot x) #xff000)<br></div><div dir= =3D"ltr">> > > > + (princ (cse-test-= foo-wslot x))<br></div><div dir=3D"ltr">> > > > + = nil)))<br></div><div dir=3D"ltr">> > > > +<br></d= iv><div dir=3D"ltr">> > > > +(with-test (:name (:cse :sap-ref-3= 2))<br></div><div dir=3D"ltr">> > > > + (assert-calls sb-= sys:sap-ref-32 1 (sap offset)<br></div><div dir=3D"ltr">> > > >= + (declare (type sb-sys:system-area-pointer sap)<br></div><di= v dir=3D"ltr">> > > > +  = ; (type sb-vm:word offset))<br></div><div dir=3D"ltr">> > > > = + (if (plusp (sb-sys:sap-ref-32 sap offset))<br></div><div dir= =3D"ltr">> > > > + (princ (sb-sys:sa= p-ref-32 sap offset))<br></div><div dir=3D"ltr">> > > > + = nil))<br></div><div dir=3D"ltr">> > > > += (assert-calls sb-sys:signed-sap-ref-32 1 (sap offset)<br></div><div = dir=3D"ltr">> > > > + (declare (type sb-sys:system= -area-pointer sap)<br></div><div dir=3D"ltr">> > > > + &n= bsp; (type sb-vm:word offset))<br></div><div d= ir=3D"ltr">> > > > + (if (plusp (sb-sys:signed-sap= -ref-32 sap offset))<br></div><div dir=3D"ltr">> > > > + = (princ (sb-sys:signed-sap-ref-32 sap offset))<br></div= ><div dir=3D"ltr">> > > > + nil)))<b= r></div><div dir=3D"ltr">> > > > +<br></div><div dir=3D"ltr">&g= t; > > > +(with-test (:name (:cse :sap-ref-64) :skipped-on (:not := 64-bit))<br></div><div dir=3D"ltr">> > > > + (assert-call= s sb-sys:sap-ref-64 1 (sap offset)<br></div><div dir=3D"ltr">> > >= > + (declare (type sb-sys:system-area-pointer sap)<br></di= v><div dir=3D"ltr">> > > > + = (type sb-vm:word offset))<br></div><div dir=3D"ltr">> > > = > + (if (plusp (sb-sys:sap-ref-64 sap offset))<br></div><di= v dir=3D"ltr">> > > > + (princ (sb-s= ys:sap-ref-64 sap offset))<br></div><div dir=3D"ltr">> > > > +&= nbsp; nil))<br></div><div dir=3D"ltr">> > > &= gt; + (assert-calls sb-sys:signed-sap-ref-64 1 (sap offset)<br></div>= <div dir=3D"ltr">> > > > + (declare (type sb-sys:s= ystem-area-pointer sap)<br></div><div dir=3D"ltr">> > > > +&nbs= p; (type sb-vm:word offset))<br></div><= div dir=3D"ltr">> > > > + (if (plusp (sb-sys:signe= d-sap-ref-64 sap offset))<br></div><div dir=3D"ltr">> > > > +&n= bsp; (princ (sb-sys:signed-sap-ref-64 sap offset))<br>= </div><div dir=3D"ltr">> > > > + nil= )))<br></div><div dir=3D"ltr">> > > > +<br></div><div dir=3D"lt= r">> > > > +(with-test (:name (:cse :loop-over-deref))<br></div= ><div dir=3D"ltr">> > > > + (let ((lexpr<br></div><div di= r=3D"ltr">> > > > + '(lambda (f)<br= ></div><div dir=3D"ltr">> > > > + &n= bsp; (declare (optimize (sb-c::alien-funcall-saves-fp-and-pc 0)<br><= /div><div dir=3D"ltr">> > > > + &nbs= p; (= sb-c::type-check 0)))<br></div><div dir=3D"ltr">> > > > + = ;; F returns a pointer to a null-termin= ated array of unsigned-int.<br></div><div dir=3D"ltr">> > > > += ;; The deref for the loop termina= tion test, and again in the body<br></div><div dir=3D"ltr">> > > &= gt; + ;; should use a single memor= y load.<br></div><div dir=3D"ltr">> > > > + = (let ((a (alien-funcall (the (alien (function (* unsi= gned))) f))))<br></div><div dir=3D"ltr">> > > > + = (do ((index 0 (1+ index)))<br></div><div= dir=3D"ltr">> > > > + = ((zerop (deref a index)))<br></div><div dir=3D"ltr">&= gt; > > > + = (princ (the fixnum (deref a index))))))))<br></div><div dir=3D"ltr">> &= gt; > > + (assert (=3D (count #+(or arm64 x86-64) 'sb-sy= s:%sap-ref-64-indexed<br></div><div dir=3D"ltr">> > > > + = #-(o= r arm64 x86-64)<br></div><div dir=3D"ltr">> > > > +  = ; (progn #+6= 4-bit 'sb-sys:sap-ref-64 #-64-bit 'sb-sys:sap-ref-32)<br></div><div dir=3D"= ltr">> > > > + = (ir-calls lexpr) :key #'combination-fun-debug-n= ame)<br></div><div dir=3D"ltr">> > > > + &n= bsp; 1))))<br></div><div dir=3D"ltr">> > > &= gt; +<br></div><div dir=3D"ltr">> > > > +;;; SETQ of a variable= used as an argument to an elidable load prevents CSE.<br></div><div dir=3D= "ltr">> > > > +;;; When a variable that participates in the loa= d expression (e.g., the cons<br></div><div dir=3D"ltr">> > > > = +;;; being CAR'd) is assigned between two identical loads, the second load<= br></div><div dir=3D"ltr">> > > > +;;; must not be eliminated b= ecause the variable may reference a different object.<br></div><div dir=3D"= ltr">> > > > +(with-test (:name (:cse :setq-of-load-arg-prevent= s-car))<br></div><div dir=3D"ltr">> > > > + ;; CONS is th= e argument to CAR. Assigning CONS between two (CAR CONS)<br></div><div dir= =3D"ltr">> > > > + ;; prevents CSE.<br></div><div dir=3D"= ltr">> > > > + (assert-calls car 2 (cons other)<br></div>= <div dir=3D"ltr">> > > > + (declare (type cons con= s other))<br></div><div dir=3D"ltr">> > > > + (let= ((a (car cons)))<br></div><div dir=3D"ltr">> > > > + &nb= sp; (setq cons other)<br></div><div dir=3D"ltr">> > > > = + (let ((b (car cons)))<br></div><div dir=3D"ltr">> = > > > + (list a b)))))<br></div><div di= r=3D"ltr">> > > > +<br></div><div dir=3D"ltr">> > > &g= t; +(with-test (:name (:cse :setq-of-load-arg-prevents-cdr))<br></div><div = dir=3D"ltr">> > > > + (assert-calls cdr 2 (cons other)<br= ></div><div dir=3D"ltr">> > > > + (declare (type c= ons cons other))<br></div><div dir=3D"ltr">> > > > + &nbs= p; (let ((a (cdr cons)))<br></div><div dir=3D"ltr">> > > > +&nb= sp; (setq cons other)<br></div><div dir=3D"ltr">> > >= ; > + (let ((b (cdr cons)))<br></div><div dir=3D"ltr= ">> > > > + (list a b)))))<br></div>= <div dir=3D"ltr">> > > > +<br></div><div dir=3D"ltr">> > = > > +(with-test (:name (:cse :setq-of-load-arg-prevents-instance-ref)= )<br></div><div dir=3D"ltr">> > > > + ;; Assigning the st= ruct variable between two reads of the same slot prevents CSE.<br></div><di= v dir=3D"ltr">> > > > + (assert-calls sb-kernel:%instance= -ref 2 (x y)<br></div><div dir=3D"ltr">> > > > + (= let ((x (truly-the cse-test-foo x))<br></div><div dir=3D"ltr">> > >= ; > + (y (truly-the cse-test-foo y)))<= br></div><div dir=3D"ltr">> > > > + (let ((= a (cse-test-foo-slot x)))<br></div><div dir=3D"ltr">> > > > +&n= bsp; (setq x y)<br></div><div dir=3D"ltr">> > &g= t; > + (let ((b (cse-test-foo-slot x)))<br></= div><div dir=3D"ltr">> > > > +  = ; (list a b))))))<br></div><div dir=3D"ltr">> > > > +<br></div>= <div dir=3D"ltr">> > > > +(with-test (:name (:cse :setq-of-load= -arg-prevents-sap-ref))<br></div><div dir=3D"ltr">> > > > +&nbs= p; ;; Assigning the SAP variable between two reads at the same offset<br></= div><div dir=3D"ltr">> > > > + ;; must prevent CSE since = the second read may use a different SAP.<br></div><div dir=3D"ltr">> >= ; > > + (assert-calls sb-sys:sap-ref-32 2 (sap1 sap2 offset)<br= ></div><div dir=3D"ltr">> > > > + (declare (type s= b-sys:system-area-pointer sap1 sap2)<br></div><div dir=3D"ltr">> > &g= t; > + (type sb-vm:word offset= ))<br></div><div dir=3D"ltr">> > > > + (let ((a (s= b-sys:sap-ref-32 sap1 offset)))<br></div><div dir=3D"ltr">> > > &g= t; + (setq sap1 sap2)<br></div><div dir=3D"ltr">> &g= t; > > + (let ((b (sb-sys:sap-ref-32 sap1 offset)= ))<br></div><div dir=3D"ltr">> > > > + &nbs= p; (list a b)))))<br></div><div dir=3D"ltr">> > > > +<br></div>= <div dir=3D"ltr">> > > > +;;; SETQ of an *unrelated* variable s= hould NOT prevent CSE.<br></div><div dir=3D"ltr">> > > > +;;; O= nly mutations of variables that participate in the load matter.<br></div><d= iv dir=3D"ltr">> > > > +(with-test (:name (:cse :setq-of-unrela= ted-var-allows-cse))<br></div><div dir=3D"ltr">> > > > + = ;; Z is not an argument to CAR, so setting Z does not inhibit CSE.<br></div= ><div dir=3D"ltr">> > > > + (assert-calls car 1 (cons z)<= br></div><div dir=3D"ltr">> > > > + (declare (type= cons cons))<br></div><div dir=3D"ltr">> > > > + (= let ((a (car cons)))<br></div><div dir=3D"ltr">> > > > + = (setq z a)<br></div><div dir=3D"ltr">> > > > +&nb= sp; (let ((b (car cons)))<br></div><div dir=3D"ltr">> >= > > + (list z b)))))<br></div><div dir=3D= "ltr">> > > > +<br></div><div dir=3D"ltr">> > > > += ;;; SB-THREAD:BARRIER of any kind prevents elision of the second load<br></= div><div dir=3D"ltr">> > > > +;;; since the memory barriers is = not flushable. This is the conservative stance.<br></div><div dir=3D"ltr">&= gt; > > > +;;; The actual (looser) requirements are more subtle th= an I care to deal with.<br></div><div dir=3D"ltr">> > > > +(def= macro barrier-test (kind)<br></div><div dir=3D"ltr">> > > > +&n= bsp; `(with-test (:name (:cse :barrier-prevents-car ,kind))<br></div><div d= ir=3D"ltr">> > > > + (assert-calls car 2 (cons)<b= r></div><div dir=3D"ltr">> > > > + (declare= (type cons cons))<br></div><div dir=3D"ltr">> > > > + &n= bsp; (let ((a (car cons)))<br></div><div dir=3D"ltr">> > > = > + (sb-thread:barrier (,kind))<br></div><div= dir=3D"ltr">> > > > + (let ((b (car= cons)))<br></div><div dir=3D"ltr">> > > > +  = ; (list a b))))))<br></div><div dir=3D"ltr">> > > &g= t; +(barrier-test :read)<br></div><div dir=3D"ltr">> > > > +(ba= rrier-test :write)<br></div><div dir=3D"ltr">> > > > +(barrier-= test :memory)<br></div><div dir=3D"ltr">> > > > +(barrier-test = :compiler)<br></div><div dir=3D"ltr">> > > > +(barrier-test :da= ta-dependency)<br></div><div dir=3D"ltr">> > > > +<br></div><di= v dir=3D"ltr">> > > > +;;; Any non-flushable call between two i= dentical loads prevents CSE<br></div><div dir=3D"ltr">> > > > += ;;; because the call may have side effects that modify the loaded memory.<b= r></div><div dir=3D"ltr">> > > > +<br></div><div dir=3D"ltr">&g= t; > > > +(with-test (:name (:cse :non-flushable-call-prevents-cse= ))<br></div><div dir=3D"ltr">> > > > + ;; PRINC is a non-= flushable<br></div><div dir=3D"ltr">> > > > + (assert-cal= ls car 2 (cons)<br></div><div dir=3D"ltr">> > > > +  = ; (declare (type cons cons))<br></div><div dir=3D"ltr">> > > > = + (let ((a (car cons)))<br></div><div dir=3D"ltr">> > &g= t; > + (princ 42)<br></div><div dir=3D"ltr">> >= ; > > + (let ((b (car cons)))<br></div><div dir= =3D"ltr">> > > > + (list a b)))))<br= ></div><div dir=3D"ltr">> > > > +<br></div><div dir=3D"ltr">>= ; > > > +;;; Different functions on the same object are NOT consid= ered common subexpressions.<br></div><div dir=3D"ltr">> > > > += ;;; (CAR x) and (CDR x) are different loads even if x is the same.<br></div= ><div dir=3D"ltr">> > > > +(with-test (:name (:cse :different-a= ccessors-not-cse))<br></div><div dir=3D"ltr">> > > > + ;;= Both CAR and CDR should appear, each exactly once.<br></div><div dir=3D"lt= r">> > > > + (assert-calls car 1 (cons)<br></div><div dir= =3D"ltr">> > > > + (declare (type cons cons))<br><= /div><div dir=3D"ltr">> > > > + (if (car cons)<br>= </div><div dir=3D"ltr">> > > > + (pr= inc (cdr cons))<br></div><div dir=3D"ltr">> > > > +  = ; nil))<br></div><div dir=3D"ltr">> > > > + = (assert-calls cdr 1 (cons)<br></div><div dir=3D"ltr">> > > > += (declare (type cons cons))<br></div><div dir=3D"ltr">> >= ; > > + (if (car cons)<br></div><div dir=3D"ltr">> &g= t; > > + (princ (cdr cons))<br></div><div = dir=3D"ltr">> > > > + nil)))<br></di= v><div dir=3D"ltr">> > > > diff --git a/xperfecthash30.lisp-exp= r b/xperfecthash30.lisp-expr<br></div><div dir=3D"ltr">> > > > = index 6a503acf0..1b7227c78 100644<br></div><div dir=3D"ltr">> > > = > --- a/xperfecthash30.lisp-expr<br></div><div dir=3D"ltr">> > >= ; > +++ b/xperfecthash30.lisp-expr<br></div><div dir=3D"ltr">> > &= gt; > @@ -1506,6 +1506,9 @@<br></div><div dir=3D"ltr">> > > >= ; (#(10BE7277 12214AE8 12E2CBDA 19739539 1F3556C7 1F644387)<br></div>= <div dir=3D"ltr">> > > > "(INTEGER BIGNUM SB-VM::UNSIGNE= D-BYTE-31 SB-VM::SIGNED-BYTE-32 FIXNUM SB-VM::POSITIVE-FIXNUM)"<br></div><d= iv dir=3D"ltr">> > > > "((& (^ val (>> val 22)= ) 7))")<br></div><div dir=3D"ltr">> > > > +(#(10D2EA4E 1224C557= 15A58D85 15B5A2B5 17524A78 1769E419 18906D08)<br></div><div dir=3D"ltr">&g= t; > > > + "(SB-C::CSET SB-C::REF DELAY SB-C::ARRAY-INDEX-CAST CAS= T SB-C::COMBINATION SB-C::CIF)"<br></div><div dir=3D"ltr">> > > &g= t; + "((& (+ (>> val 1) (>> val 9)) 7))")<br></div><div dir= =3D"ltr">> > > > (#(10D2EA4E 1224C557 15A58D85 15B5A2B5 1= 7524A78 1769E419 18906D08 19577539 1C065CB8 1D66C932)<br></div><div dir=3D"= ltr">> > > > "#(((:TYPE SB-C::REF)) ((:TYPE SB-C::COMBIN= ATION)) ((:TYPE SB-C::CIF)) ((:TYPE SB-C::CRETURN)) ((:TYPE SB-C::MV-COMBIN= ATION)) ((:TYPE EXIT)) ((:TYPE SB-C::CSET)) ((:TYPE DELAY) (:TYPE SB-C::ARR= AY-INDEX-CAST) (:TYPE CAST)))"<br></div><div dir=3D"ltr">> > > >= ; "((let ((tab #a((8) (unsigned-byte 8) 0 5 2 8 13 3 0 0)))<br></div= ><div dir=3D"ltr">> > > > diff --git a/xperfecthash61.lisp-expr= b/xperfecthash61.lisp-expr<br></div><div dir=3D"ltr">> > > > i= ndex 6eb72486b..b1bc014fb 100644<br></div><div dir=3D"ltr">> > > &= gt; --- a/xperfecthash61.lisp-expr<br></div><div dir=3D"ltr">> > >= > +++ b/xperfecthash61.lisp-expr<br></div><div dir=3D"ltr">> > &g= t; > @@ -463,6 +463,9 @@<br></div><div dir=3D"ltr">> > > >&n= bsp; (#(9A320D4 39CAA339 43BBEE18 4D61368F 53222DFB BFA86189 EDA1037F FEE99= A95)<br></div><div dir=3D"ltr">> > > > "#(((:TYPE SB-C::= REF)) ((:TYPE SB-C::COMBINATION)) ((:TYPE SB-C::MV-COMBINATION)) ((:TYPE EX= IT)) ((:TYPE SB-C::CSET)) ((:TYPE DELAY) (:TYPE SB-C::ARRAY-INDEX-CAST) (:T= YPE CAST)))"<br></div><div dir=3D"ltr">> > > > "((& = (- (>> val 3) (>> val 29)) 7))")<br></div><div dir=3D"ltr">>= > > > +(#(9A320D4 39CAA339 43BBEE18 53222DFB 9380837C BFA86189 FE= E99A95)<br></div><div dir=3D"ltr">> > > > + "#(((:TYPE SB-C::CI= F) (:TYPE SB-C::COMBINATION) (:TYPE DELAY) (:TYPE SB-C::ARRAY-INDEX-CAST) (= :TYPE CAST) (:TYPE SB-C::REF) (:TYPE SB-C::CSET)))"<br></div><div dir=3D"lt= r">> > > > + "((& (+ val (>> val 31)) 7))")<br></div>= <div dir=3D"ltr">> > > > (#(9A320D4 43BBEE18 53222DFB A8A= 4C7D2 BFA86189 EAA3DA5C FEE99A95)<br></div><div dir=3D"ltr">> > > = > "#(((:TYPE SB-C::REF)) ((:TYPE DELAY) (:TYPE SB-C::ARRAY-INDEX-= CAST) (:TYPE CAST)) ((:TYPE SB-C::COMBINATION)) ((:TYPE SB-C::ENTRY)) ((:TY= PE SB-C::ENCLOSE)))"<br></div><div dir=3D"ltr">> > > > "= ((& (^ (>> val 7) (>> val 23)) 7))")<br></div><div dir=3D"l= tr">> > > > diff --git a/xperfecthash63.lisp-expr b/xperfecthas= h63.lisp-expr<br></div><div dir=3D"ltr">> > > > index cc861bb33= ..13bb5d85d 100644<br></div><div dir=3D"ltr">> > > > --- a/xper= fecthash63.lisp-expr<br></div><div dir=3D"ltr">> > > > +++ b/xp= erfecthash63.lisp-expr<br></div><div dir=3D"ltr">> > > > @@ -87= 0,6 +870,9 @@<br></div><div dir=3D"ltr">> > > > (#(121068= DD 4D61368F 58110E7F 67EE2D1A 6D9A883D 74589D82 897B4656 A68A3965)<br></div= ><div dir=3D"ltr">> > > > "#(((: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)))"<= br></div><div dir=3D"ltr">> > > > "((& (- (>> = val 4) (>> val 16)) 7))")<br></div><div dir=3D"ltr">> > > &g= t; +(#(121068DD 58110E7F 67EE2D1A 6D9A883D 742D4C54 897B4656 A68A3965)<br><= /div><div dir=3D"ltr">> > > > + "#(((: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)))"<br></div><div dir=3D"ltr">> >= > > + "((& (- (>> val 4) (>> val 16)) 7))")<br></div= ><div dir=3D"ltr">> > > > (#(126ADB02 31B095DD 42D83FFB 4= 341F7D8 63C971D7 7A80F201 7B408880 8F7912D6 EBD01872)<br></div><div dir=3D"= ltr">> > > > "(:ALLOW-OTHER-KEYS :TYPE :RESULT-SPECS :AR= G-SPECS :CALLER :DEPS :FIRED :LEXENV :SOURCE-PATH)"<br></div><div dir=3D"lt= r">> > > > "((let ((tab #a((8) (unsigned-byte 8) 0 5 0 3= 0 5 12 6)))<br></div><div dir=3D"ltr">> > > ><br></div><div di= r=3D"ltr">> > > > ---------------------------------------------= --------------------------<br></div><div dir=3D"ltr">> > > ><br= ></div><div dir=3D"ltr">> > > ><br></div><div dir=3D"ltr">> = > > > hooks/post-receive<br></div><div dir=3D"ltr">> > > = > --<br></div><div dir=3D"ltr">> > > > SBCL<br></div><div di= r=3D"ltr">> > > ><br></div><div dir=3D"ltr">> > > >= <br></div><div dir=3D"ltr">> > > > ____________________________= ___________________<br></div><div dir=3D"ltr">> > > > Sbcl-comm= its mailing list<br></div><div dir=3D"ltr">> > > > <a ymailto= =3D"mailto:[email protected]" href=3D"mailto:Sbcl-commits@= lists.sourceforge.net">[email protected]</a><br></div><div= dir=3D"ltr">> > > > <a href=3D"https://lists.sourceforge.net/l= ists/listinfo/sbcl-commits" target=3D"_blank">https://lists.sourceforge.net= /lists/listinfo/sbcl-commits</a><br></div><div dir=3D"ltr"><br></div><div d= ir=3D"ltr"><br></div><div dir=3D"ltr">_____________________________________= __________<br></div><div dir=3D"ltr">Sbcl-commits mailing list<br></div><di= v dir=3D"ltr"><a ymailto=3D"mailto:[email protected]" href= =3D"mailto:[email protected]">[email protected]= ge.net</a><br></div><div dir=3D"ltr"><a href=3D"https://lists.sourceforge.n= et/lists/listinfo/sbcl-commits" target=3D"_blank">https://lists.sourceforge= .net/lists/listinfo/sbcl-commits</a><br></div><blockquote></blockquote></bl= ockquote></div> </body></html> ------=_Part_1714915_1527299352.1785838154448-- --===============6044065898161819733== Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline --===============6044065898161819733== Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Sbcl-commits mailing list [email protected] https://lists.sourceforge.net/lists/listinfo/sbcl-commits --===============6044065898161819733==--