# HG changeset patch # User Steve Losh # Date 1459117852 0 # Node ID 0b1008a7fe76c948dcf554e2bda229e2769fe7d7 # Parent 87afb11b9791d860b23d276903727b382d9aa1f7 Fiddle with and document the unification instructions a bit diff -r 87afb11b9791 -r 0b1008a7fe76 src/wam/dump.lisp --- a/src/wam/dump.lisp Sun Mar 27 22:25:43 2016 +0000 +++ b/src/wam/dump.lisp Sun Mar 27 22:30:52 2016 +0000 @@ -87,4 +87,5 @@ (arity (cell-functor-arity cell))) (list* functor (loop :for i :from (1+ address) :to (+ address arity) - :collect (extract-thing wam i)))))))) + :collect (extract-thing wam i))))) + (t (error "What to heck is this?"))))) diff -r 87afb11b9791 -r 0b1008a7fe76 src/wam/instructions.lisp --- a/src/wam/instructions.lisp Sun Mar 27 22:25:43 2016 +0000 +++ b/src/wam/instructions.lisp Sun Mar 27 22:30:52 2016 +0000 @@ -28,19 +28,21 @@ arity))) -(defun* bound-reference-p ((address heap-index) (cell heap-cell)) +(defun* bound-reference-p ((wam wam) (address heap-index)) (:returns boolean) - "Return whether `cell` is a bound reference, assuming it lives at `address`." + "Return whether the cell at `address` is a bound reference." (ensure-boolean - (and (cell-reference-p cell) - (not (= (cell-value cell) address))))) + (let ((cell (wam-heap-cell wam address))) + (and (cell-reference-p cell) + (not (= (cell-value cell) address)))))) -(defun* unbound-reference-p ((address heap-index) (cell heap-cell)) +(defun* unbound-reference-p ((wam wam) (address heap-index)) (:returns boolean) - "Return whether `cell` is an unbound reference, assuming it lives at `address`." + "Return whether the cell at `address` is an unbound reference." (ensure-boolean - (and (cell-reference-p cell) - (= (cell-value cell) address)))) + (let ((cell (wam-heap-cell wam address))) + (and (cell-reference-p cell) + (= (cell-value cell) address))))) (defun* matching-functor-p ((wam wam) (cell heap-cell) @@ -64,33 +66,39 @@ will be returned. " - (let ((cell (wam-heap-cell wam address))) - (if (bound-reference-p address cell) - (deref wam (cell-value cell)) - address))) + (if (bound-reference-p wam address) + (deref wam (cell-value (wam-heap-cell wam address))) + address)) -(defun* bind! ((wam wam) (address heap-index) (target heap-index)) - "Bind the reference cell at `address` to `target`. +(defun* bind! ((wam wam) (address-1 heap-index) (address-2 heap-index)) + (:returns :void) + "Bind the unbound reference cell to the other. - The reference cell must be unbound to begin with. - TODO: are we sure about this? + `bind!` takes two addresses as arguments. At least one of these *must* refer + to an unbound reference cell. This unbound reference will be bound to point + at the other address. - `target` doesn't necessarily need to exist yet. - TODO: this seems dangerous... + If both addresses refer to unbound references, the direction of the binding is + chosen arbitrarily. " - (assert (unbound-reference-p address - (wam-heap-cell wam address)) - () - "Cannot bind address ~D because it is not an unbound reference." - address) - (setf (wam-heap-cell wam address) - (make-cell-reference target))) + (cond + ((unbound-reference-p wam address-1) + (setf (wam-heap-cell wam address-1) + (make-cell-reference address-2))) + ((unbound-reference-p wam address-2) + (setf (wam-heap-cell wam address-2) + (make-cell-reference address-1))) + (t (error "At least one cell must be an unbound reference when binding."))) + (values)) + (defun* fail! ((wam wam)) + (:returns :void) "Mark a failure in the WAM." - (setf (wam-fail wam) t)) + (setf (wam-fail wam) t) + (values)) (defun* unify ((wam wam) (a1 heap-index) (a2 heap-index)) @@ -130,19 +138,47 @@ (let* ((addr (deref wam (wam-register wam register))) (cell (wam-heap-cell wam addr))) (cond - ;; If the register points at a reference cell + ;; If the register points at a reference cell, we push two new cells onto + ;; the heap: + ;; + ;; | N | STR | N+1 | + ;; | N+1 | FUN | f/n | + ;; + ;; Then we bind this reference cell to point at the new structure and flip + ;; over to write mode. + ;; + ;; It seems a bit confusing that we don't push the rest of the structure + ;; stuff on the heap after it too. But that's going to happen in the next + ;; few instructions (which will be unify-*'s, executed in write mode). ((cell-reference-p cell) - (bind! wam addr (wam-heap-pointer wam)) - (push-new-structure! wam) - (push-new-functor! wam functor arity) - (setf (wam-mode wam) :write)) - ;; If the register points at a structure cell + (let ((new-structure-address (nth-value 1 (push-new-structure! wam)))) + (push-new-functor! wam functor arity) + (bind! wam addr new-structure-address) + (setf (wam-mode wam) :write))) + + ;; If the register points at a structure cell, then we look at where that + ;; cell points (which will be the functor cell for the structure): + ;; + ;; | N | STR | M | points at the structure, not necessarily contiguous + ;; | ... | + ;; | M | FUN | f/2 | the functor (hopefully it matches) + ;; | M+1 | ... | ... | pieces of the structure, always contiguous + ;; | M+2 | ... | ... | and always right after the functor + ;; + ;; If it matches the functor we're looking for, we can proceed. We set + ;; the S register to the address of the first subform we need to match + ;; (M+1 in the example above). + ;; + ;; What about if it's a 0-arity functor? The S register will be set to + ;; garbage. But that's okay, because we know the next thing in the stream + ;; of instructions will be another get-structure and we'll just blow away + ;; the S register there. ((cell-structure-p cell) - (let* ((target-addr (cell-value cell)) - (target (wam-heap-cell wam target-addr))) - (if (matching-functor-p wam target functor arity) + (let* ((functor-addr (cell-value cell)) + (functor-cell (wam-heap-cell wam functor-addr))) + (if (matching-functor-p wam functor-cell functor arity) (progn - (setf (wam-s wam) (1+ target-addr)) + (setf (wam-s wam) (1+ functor-addr)) (setf (wam-mode wam) :read)) (fail! wam)))) (t (fail! wam))))