abffacd7848a

Merge the code I accidentally branched off because I'm an idiot
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Mon, 11 Jul 2016 16:26:05 +0000
parents 3b0161d2100d (current diff) 8cd3257c58e3 (diff)
children 96258fb7be70
branches/tags (none)
files src/wam/bytecode.lisp src/wam/compiler.lisp src/wam/constants.lisp src/wam/vm.lisp

Changes

--- a/src/circle.lisp	Mon Jul 11 16:17:18 2016 +0000
+++ b/src/circle.lisp	Mon Jul 11 16:26:05 2016 +0000
@@ -28,8 +28,8 @@
 ;;; 2. When we see a `:get-structure-* CONSTANT LOCALREG` instruction:
 ;;;   A. Remove it in-place, so the next node will be processed on the next
 ;;;      iteration (remember, we're iterating backwards).
-;;;   B. Search forward for the corresponding `:unify-variable` instruction and
-;;;      replace it in-place with the `:unify-constant` instruction.
+;;;   B. Search forward for the corresponding `:subterm-variable` instruction
+;;;      and replace it in-place with the `:subterm-constant` instruction.
 ;;;
 ;;; Of course you could do all this with immutable data structures, but it'll be
 ;;; pretty slow.  And since one of the primary goals of this project is to be
--- a/src/wam/bytecode.lisp	Mon Jul 11 16:17:18 2016 +0000
+++ b/src/wam/bytecode.lisp	Mon Jul 11 16:26:05 2016 +0000
@@ -9,27 +9,23 @@
   (#.+opcode-noop+ 1)
 
   (#.+opcode-get-structure+ 3)
-  (#.+opcode-unify-variable-local+ 2)
-  (#.+opcode-unify-variable-stack+ 2)
-  (#.+opcode-unify-value-local+ 2)
-  (#.+opcode-unify-value-stack+ 2)
-  (#.+opcode-unify-void+ 2)
   (#.+opcode-get-variable-local+ 3)
   (#.+opcode-get-variable-stack+ 3)
   (#.+opcode-get-value-local+ 3)
   (#.+opcode-get-value-stack+ 3)
 
   (#.+opcode-put-structure+ 3)
-  (#.+opcode-set-variable-local+ 2)
-  (#.+opcode-set-variable-stack+ 2)
-  (#.+opcode-set-value-local+ 2)
-  (#.+opcode-set-value-stack+ 2)
-  (#.+opcode-set-void+ 2)
   (#.+opcode-put-variable-local+ 3)
   (#.+opcode-put-variable-stack+ 3)
   (#.+opcode-put-value-local+ 3)
   (#.+opcode-put-value-stack+ 3)
 
+  (#.+opcode-subterm-variable-local+ 2)
+  (#.+opcode-subterm-variable-stack+ 2)
+  (#.+opcode-subterm-value-local+ 2)
+  (#.+opcode-subterm-value-stack+ 2)
+  (#.+opcode-subterm-void+ 2)
+
   (#.+opcode-call+ 2)
   (#.+opcode-dynamic-call+ 1)
   (#.+opcode-proceed+ 1)
@@ -42,9 +38,8 @@
   (#.+opcode-cut+ 1)
 
   (#.+opcode-get-constant+ 3)
-  (#.+opcode-set-constant+ 2)
   (#.+opcode-put-constant+ 3)
-  (#.+opcode-unify-constant+ 2)
+  (#.+opcode-subterm-constant+ 2)
 
   (#.+opcode-get-list+ 2)
   (#.+opcode-put-list+ 2))
@@ -56,28 +51,25 @@
   (:returns string)
   (eswitch (opcode)
     (+opcode-noop+ "NOOP")
+
     (+opcode-get-structure+ "GET-STRUCTURE")
-    (+opcode-unify-variable-local+ "UNIFY-VARIABLE")
-    (+opcode-unify-variable-stack+ "UNIFY-VARIABLE")
-    (+opcode-unify-value-local+ "UNIFY-VALUE")
-    (+opcode-unify-value-stack+ "UNIFY-VALUE")
-    (+opcode-unify-void+ "UNIFY-VOID")
     (+opcode-get-variable-local+ "GET-VARIABLE")
     (+opcode-get-variable-stack+ "GET-VARIABLE")
     (+opcode-get-value-local+ "GET-VALUE")
     (+opcode-get-value-stack+ "GET-VALUE")
 
     (+opcode-put-structure+ "PUT-STRUCTURE")
-    (+opcode-set-variable-local+ "SET-VARIABLE")
-    (+opcode-set-variable-stack+ "SET-VARIABLE")
-    (+opcode-set-value-local+ "SET-VALUE")
-    (+opcode-set-value-stack+ "SET-VALUE")
-    (+opcode-set-void+ "SET-VOID")
     (+opcode-put-variable-local+ "PUT-VARIABLE")
     (+opcode-put-variable-stack+ "PUT-VARIABLE")
     (+opcode-put-value-local+ "PUT-VALUE")
     (+opcode-put-value-stack+ "PUT-VALUE")
 
+    (+opcode-subterm-variable-local+ "SUBTERM-VARIABLE")
+    (+opcode-subterm-variable-stack+ "SUBTERM-VARIABLE")
+    (+opcode-subterm-value-local+ "SUBTERM-VALUE")
+    (+opcode-subterm-value-stack+ "SUBTERM-VALUE")
+    (+opcode-subterm-void+ "SUBTERM-VOID")
+
     (+opcode-call+ "CALL")
     (+opcode-dynamic-call+ "DYNAMIC-CALL")
     (+opcode-proceed+ "PROCEED")
@@ -90,9 +82,8 @@
     (+opcode-cut+ "CUT")
 
     (+opcode-get-constant+ "GET-CONSTANT")
-    (+opcode-set-constant+ "SET-CONSTANT")
     (+opcode-put-constant+ "PUT-CONSTANT")
-    (+opcode-unify-constant+ "UNIFY-CONSTANT")
+    (+opcode-subterm-constant+ "SUBTERM-CONSTANT")
 
     (+opcode-get-list+ "GET-LIST")
     (+opcode-put-list+ "PUT-LIST")))
@@ -103,27 +94,23 @@
     (+opcode-noop+ "NOOP")
 
     (+opcode-get-structure+ "GETS")
-    (+opcode-unify-variable-local+ "UVAR")
-    (+opcode-unify-variable-stack+ "UVAR")
-    (+opcode-unify-value-local+ "UVLU")
-    (+opcode-unify-value-stack+ "UVLU")
-    (+opcode-unify-void+ "UVOI")
     (+opcode-get-variable-local+ "GVAR")
     (+opcode-get-variable-stack+ "GVAR")
     (+opcode-get-value-local+ "GVLU")
     (+opcode-get-value-stack+ "GVLU")
 
     (+opcode-put-structure+ "PUTS")
-    (+opcode-set-variable-local+ "SVAR")
-    (+opcode-set-variable-stack+ "SVAR")
-    (+opcode-set-value-local+ "SVLU")
-    (+opcode-set-value-stack+ "SVLU")
-    (+opcode-set-void+ "SVOI")
     (+opcode-put-variable-local+ "PVAR")
     (+opcode-put-variable-stack+ "PVAR")
     (+opcode-put-value-local+ "PVLU")
     (+opcode-put-value-stack+ "PVLU")
 
+    (+opcode-subterm-variable-local+ "SVAR")
+    (+opcode-subterm-variable-stack+ "SVAR")
+    (+opcode-subterm-value-local+ "SVLU")
+    (+opcode-subterm-value-stack+ "SVLU")
+    (+opcode-subterm-void+ "SVOI")
+
     (+opcode-call+ "CALL")
     (+opcode-dynamic-call+ "DYCL")
     (+opcode-proceed+ "PROC")
@@ -136,9 +123,8 @@
     (+opcode-cut+ "CUTT")
 
     (+opcode-get-constant+ "GCON")
-    (+opcode-set-constant+ "SCON")
     (+opcode-put-constant+ "PCON")
-    (+opcode-unify-constant+ "UCON")
+    (+opcode-subterm-constant+ "UCON")
 
     (+opcode-get-list+ "GLST")
     (+opcode-put-list+ "PLST")))
--- a/src/wam/compiler.lisp	Mon Jul 11 16:17:18 2016 +0000
+++ b/src/wam/compiler.lisp	Mon Jul 11 16:26:05 2016 +0000
@@ -882,11 +882,11 @@
 ;;; into a list of instructions, each of which is a list:
 ;;;
 ;;;   (:put-structure X2 q 2)
-;;;   (:set-variable X1)
-;;;   (:set-variable X3)
+;;;   (:subterm-variable X1)
+;;;   (:subterm-variable X3)
 ;;;   (:put-structure X0 p 2)
-;;;   (:set-value X1)
-;;;   (:set-value X2)
+;;;   (:subterm-value X1)
+;;;   (:subterm-value X2)
 ;;;
 ;;; The opcodes are keywords and the register arguments remain register objects.
 ;;; They get converted down to the raw bytes in the final "rendering" step.
@@ -994,24 +994,14 @@
                (:program :get-list)
                (:query :put-list)))
       (:register (if first-seen
-                   (case mode
-                     (:program (case register-variant
-                                 (:local :unify-variable-local)
-                                 (:stack :unify-variable-stack)
-                                 (:void :unify-void)))
-                     (:query (case register-variant
-                               (:local :set-variable-local)
-                               (:stack :set-variable-stack)
-                               (:void :set-void))))
-                   (case mode
-                     (:program (case register-variant
-                                 (:local :unify-value-local)
-                                 (:stack :unify-value-stack)
-                                 (:void :unify-void)))
-                     (:query (case register-variant
-                               (:local :set-value-local)
-                               (:stack :set-value-stack)
-                               (:void :set-void)))))))))
+                   (case register-variant
+                     (:local :subterm-variable-local)
+                     (:stack :subterm-variable-stack)
+                     (:void :subterm-void))
+                   (case register-variant
+                     (:local :subterm-value-local)
+                     (:stack :subterm-value-stack)
+                     (:void :subterm-void)))))))
 
 
 (defun precompile-tokens (wam head-tokens body-tokens)
@@ -1080,11 +1070,11 @@
          (handle-register (register)
            (if (register-anonymous-p register)
              ;; VOID 1
-             (push-instruction (find-opcode :register nil mode register) 1)
+             (push-instruction (find-opcode :register nil nil register) 1)
              ;; OP reg
              (let ((first-seen (push-if-new register seen :test #'register=)))
                (push-instruction
-                 (find-opcode :register first-seen mode register)
+                 (find-opcode :register first-seen nil register)
                  register))))
          (handle-token (token)
            (etypecase token
@@ -1263,35 +1253,35 @@
   ;; 2. put_structure c/0, Ai -> put_constant c, Ai
   (circle-replace node `(:put-constant ,constant ,register)))
 
-(defun optimize-set-constant (node constant register)
+(defun optimize-subterm-constant-query (node constant register)
   ;; 3. put_structure c/0, Xi                     *** WE ARE HERE
   ;;    ...
-  ;;    set_value Xi          -> set_constant c
+  ;;    subterm_value Xi          -> subterm_constant c
   (loop
     :with previous = (circle-prev node)
-    ;; Search forward for the corresponding set-value instruction
+    ;; Search for the corresponding set-value instruction
     :for n = (circle-forward-remove node) :then (circle-forward n)
     :while n
     :for (opcode . arguments) = (circle-value n)
-    :when (and (eql opcode :set-value-local)
+    :when (and (eql opcode :subterm-value-local)
                (register= register (first arguments)))
     :do
-    (circle-replace n `(:set-constant ,constant))
+    (circle-replace n `(:subterm-constant ,constant))
     (return previous)))
 
-(defun optimize-unify-constant (node constant register)
-  ;; 4. unify_variable Xi     -> unify_constant c
+(defun optimize-subterm-constant-program (node constant register)
+  ;; 4. subterm_variable Xi       -> subterm_constant c
   ;;    ...
   ;;    get_structure c/0, Xi                     *** WE ARE HERE
   (loop
-    ;; Search backward for the corresponding unify-variable instruction
+    ;; Search backward for the corresponding subterm-variable instruction
     :for n = (circle-backward node) :then (circle-backward n)
     :while n
     :for (opcode . arguments) = (circle-value n)
-    :when (and (eql opcode :unify-variable-local)
+    :when (and (eql opcode :subterm-variable-local)
                (register= register (first arguments)))
     :do
-    (circle-replace n `(:unify-constant ,constant))
+    (circle-replace n `(:subterm-constant ,constant))
     (return (circle-backward-remove node))))
 
 (defun optimize-constants (wam instructions)
@@ -1310,14 +1300,14 @@
              (setf node
                    (if (register-argument-p register)
                      (optimize-put-constant node functor register)
-                     (optimize-set-constant node functor register))))
+                     (optimize-subterm-constant-query node functor register))))
 
             ((guard `(:get-structure ,functor ,register)
                     (constant-p functor))
              (setf node
                    (if (register-argument-p register)
                      (optimize-get-constant node functor register)
-                     (optimize-unify-constant node functor register))))))
+                     (optimize-subterm-constant-program node functor register))))))
     instructions))
 
 
@@ -1330,7 +1320,7 @@
     :while node
     :for opcode = (car (circle-value node))
     :when (or (eq opcode :set-void)
-              (eq opcode :unify-void))
+              (eq opcode :subterm-void))
     :do
     (loop
       :with beginning = (circle-backward node)
@@ -1386,42 +1376,36 @@
 
 (defun render-opcode (opcode)
   (ecase opcode
-    (:get-structure        +opcode-get-structure+)
-    (:unify-variable-local +opcode-unify-variable-local+)
-    (:unify-variable-stack +opcode-unify-variable-stack+)
-    (:unify-value-local    +opcode-unify-value-local+)
-    (:unify-value-stack    +opcode-unify-value-stack+)
-    (:unify-void           +opcode-unify-void+)
-    (:get-variable-local   +opcode-get-variable-local+)
-    (:get-variable-stack   +opcode-get-variable-stack+)
-    (:get-value-local      +opcode-get-value-local+)
-    (:get-value-stack      +opcode-get-value-stack+)
-    (:put-structure        +opcode-put-structure+)
-    (:set-variable-local   +opcode-set-variable-local+)
-    (:set-variable-stack   +opcode-set-variable-stack+)
-    (:set-value-local      +opcode-set-value-local+)
-    (:set-value-stack      +opcode-set-value-stack+)
-    (:set-void             +opcode-set-void+)
-    (:put-variable-local   +opcode-put-variable-local+)
-    (:put-variable-stack   +opcode-put-variable-stack+)
-    (:put-value-local      +opcode-put-value-local+)
-    (:put-value-stack      +opcode-put-value-stack+)
-    (:put-constant         +opcode-put-constant+)
-    (:get-constant         +opcode-get-constant+)
-    (:set-constant         +opcode-set-constant+)
-    (:get-list             +opcode-get-list+)
-    (:put-list             +opcode-put-list+)
-    (:unify-constant       +opcode-unify-constant+)
-    (:call                 +opcode-call+)
-    (:dynamic-call         +opcode-dynamic-call+)
-    (:proceed              +opcode-proceed+)
-    (:allocate             +opcode-allocate+)
-    (:deallocate           +opcode-deallocate+)
-    (:done                 +opcode-done+)
-    (:try                  +opcode-try+)
-    (:retry                +opcode-retry+)
-    (:trust                +opcode-trust+)
-    (:cut                  +opcode-cut+)))
+    (:get-structure          +opcode-get-structure+)
+    (:get-variable-local     +opcode-get-variable-local+)
+    (:get-variable-stack     +opcode-get-variable-stack+)
+    (:get-value-local        +opcode-get-value-local+)
+    (:get-value-stack        +opcode-get-value-stack+)
+    (:put-structure          +opcode-put-structure+)
+    (:put-variable-local     +opcode-put-variable-local+)
+    (:put-variable-stack     +opcode-put-variable-stack+)
+    (:put-value-local        +opcode-put-value-local+)
+    (:put-value-stack        +opcode-put-value-stack+)
+    (:subterm-variable-local +opcode-subterm-variable-local+)
+    (:subterm-variable-stack +opcode-subterm-variable-stack+)
+    (:subterm-value-local    +opcode-subterm-value-local+)
+    (:subterm-value-stack    +opcode-subterm-value-stack+)
+    (:subterm-void           +opcode-subterm-void+)
+    (:put-constant           +opcode-put-constant+)
+    (:get-constant           +opcode-get-constant+)
+    (:get-list               +opcode-get-list+)
+    (:put-list               +opcode-put-list+)
+    (:subterm-constant       +opcode-subterm-constant+)
+    (:call                   +opcode-call+)
+    (:dynamic-call           +opcode-dynamic-call+)
+    (:proceed                +opcode-proceed+)
+    (:allocate               +opcode-allocate+)
+    (:deallocate             +opcode-deallocate+)
+    (:done                   +opcode-done+)
+    (:try                    +opcode-try+)
+    (:retry                  +opcode-retry+)
+    (:trust                  +opcode-trust+)
+    (:cut                    +opcode-cut+)))
 
 (defun render-argument (argument)
   (etypecase argument
--- a/src/wam/constants.lisp	Mon Jul 11 16:17:18 2016 +0000
+++ b/src/wam/constants.lisp	Mon Jul 11 16:26:05 2016 +0000
@@ -119,11 +119,6 @@
 
   ;; Program
   +opcode-get-structure+
-  +opcode-unify-variable-local+
-  +opcode-unify-variable-stack+
-  +opcode-unify-value-local+
-  +opcode-unify-value-stack+
-  +opcode-unify-void+
   +opcode-get-variable-local+
   +opcode-get-variable-stack+
   +opcode-get-value-local+
@@ -131,16 +126,18 @@
 
   ;; Query
   +opcode-put-structure+
-  +opcode-set-variable-local+
-  +opcode-set-variable-stack+
-  +opcode-set-value-local+
-  +opcode-set-value-stack+
-  +opcode-set-void+
   +opcode-put-variable-local+
   +opcode-put-variable-stack+
   +opcode-put-value-local+
   +opcode-put-value-stack+
 
+  ;; Subterm
+  +opcode-subterm-variable-local+
+  +opcode-subterm-variable-stack+
+  +opcode-subterm-value-local+
+  +opcode-subterm-value-stack+
+  +opcode-subterm-void+
+
   ;; Control
   +opcode-call+
   +opcode-dynamic-call+
@@ -155,9 +152,8 @@
 
   ;; Constants
   +opcode-get-constant+
-  +opcode-set-constant+
   +opcode-put-constant+
-  +opcode-unify-constant+
+  +opcode-subterm-constant+
 
   ;; Lists
   +opcode-get-list+
--- a/src/wam/dump.lisp	Mon Jul 11 16:17:18 2016 +0000
+++ b/src/wam/dump.lisp	Mon Jul 11 16:26:05 2016 +0000
@@ -155,26 +155,6 @@
           (pretty-arguments arguments)))
 
 
-(defmethod instruction-details ((opcode (eql +opcode-set-variable-local+)) arguments functor-list)
-  (format nil "SVAR~A      ; X~A <- new unbound REF"
-          (pretty-arguments arguments)
-          (first arguments)))
-
-(defmethod instruction-details ((opcode (eql +opcode-set-variable-stack+)) arguments functor-list)
-  (format nil "SVAR~A      ; Y~A <- new unbound REF"
-          (pretty-arguments arguments)
-          (first arguments)))
-
-(defmethod instruction-details ((opcode (eql +opcode-set-value-local+)) arguments functor-list)
-  (format nil "SVLU~A      ; new REF to X~A"
-          (pretty-arguments arguments)
-          (first arguments)))
-
-(defmethod instruction-details ((opcode (eql +opcode-set-value-stack+)) arguments functor-list)
-  (format nil "SVLU~A      ; new REF to Y~A"
-          (pretty-arguments arguments)
-          (first arguments)))
-
 (defmethod instruction-details ((opcode (eql +opcode-get-structure+)) arguments functor-list)
   (format nil "GETS~A ; X~A = ~A"
           (pretty-arguments arguments)
@@ -252,13 +232,8 @@
           (second arguments)
           (pretty-functor (first arguments) functor-list)))
 
-(defmethod instruction-details ((opcode (eql +opcode-set-constant+)) arguments functor-list)
-  (format nil "SCON~A      ; SET CONSTANT ~A"
-          (pretty-arguments arguments)
-          (pretty-functor (first arguments) functor-list)))
-
-(defmethod instruction-details ((opcode (eql +opcode-unify-constant+)) arguments functor-list)
-  (format nil "UCON~A      ; UNIFY CONSTANT ~A"
+(defmethod instruction-details ((opcode (eql +opcode-subterm-constant+)) arguments functor-list)
+  (format nil "SCON~A      ; SUBTERM CONSTANT ~A"
           (pretty-arguments arguments)
           (pretty-functor (first arguments) functor-list)))
 
--- a/src/wam/vm.lisp	Mon Jul 11 16:17:18 2016 +0000
+++ b/src/wam/vm.lisp	Mon Jul 11 16:26:05 2016 +0000
@@ -348,28 +348,19 @@
      (register register-index))
   (setf (wam-local-register wam register)
         (make-cell-structure
-          (nth-value 1 (push-new-functor! wam functor)))))
+          (nth-value 1 (push-new-functor! wam functor)))
+
+        (wam-mode wam)
+        :write))
 
 (define-instruction %put-list
     ((wam wam)
      (register register-index))
   (setf (wam-local-register wam register)
-        (make-cell-list (wam-heap-pointer wam))))
-
-(define-instructions (%set-variable-local %set-variable-stack)
-    ((wam wam)
-     (register register-index))
-  (setf (%wam-register% wam register)
-        (push-unbound-reference! wam)))
+        (make-cell-list (wam-heap-pointer wam))
 
-(define-instructions (%set-value-local %set-value-stack)
-    ((wam wam)
-     (register register-index))
-  (wam-heap-push! wam (%wam-register% wam register)))
-
-(define-instruction %set-void ((wam wam) (n arity))
-  (repeat n
-    (push-unbound-reference! wam)))
+        (wam-mode wam)
+        :write))
 
 (define-instructions (%put-variable-local %put-variable-stack)
     ((wam wam)
@@ -377,14 +368,15 @@
      (argument register-index))
   (let ((new-reference (push-unbound-reference! wam)))
     (setf (%wam-register% wam register) new-reference
-          (wam-local-register wam argument) new-reference)))
+          (wam-local-register wam argument) new-reference
+          (wam-mode wam) :write)))
 
 (define-instructions (%put-value-local %put-value-stack)
     ((wam wam)
      (register register-index)
      (argument register-index))
-  (setf (wam-local-register wam argument)
-        (%wam-register% wam register)))
+  (setf (wam-local-register wam argument) (%wam-register% wam register)
+        (wam-mode wam) :write))
 
 
 ;;;; Program Instructions
@@ -406,7 +398,7 @@
         ;;
         ;; 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
+        ;; next few instructions (which will be subterm-*'s, executed in write
         ;; mode).
         ((cell-reference-p cell)
          (let ((structure-address (nth-value 1 (push-new-structure! wam)))
@@ -460,29 +452,6 @@
 
       (t (backtrack! wam)))))
 
-(define-instructions (%unify-variable-local %unify-variable-stack)
-    ((wam wam)
-     (register register-index))
-  (setf (%wam-register% wam register)
-        (ecase (wam-mode wam)
-          (:read (wam-heap-cell wam (wam-subterm wam)))
-          (:write (push-unbound-reference! wam))))
-  (incf (wam-subterm wam)))
-
-(define-instructions (%unify-value-local %unify-value-stack)
-    ((wam wam)
-     (register register-index))
-  (ecase (wam-mode wam)
-    (:read (unify! wam register (wam-subterm wam)))
-    (:write (wam-heap-push! wam (%wam-register% wam register))))
-  (incf (wam-subterm wam)))
-
-(define-instruction %unify-void ((wam wam) (n arity))
-  (ecase (wam-mode wam)
-    (:read (incf (wam-subterm wam) n))
-    (:write (repeat n
-              (push-unbound-reference! wam)))))
-
 (define-instructions (%get-variable-local %get-variable-stack)
     ((wam wam)
      (register register-index)
@@ -497,6 +466,31 @@
   (unify! wam register argument))
 
 
+;;;; Subterm Instructions
+(define-instructions (%subterm-variable-local %subterm-variable-stack)
+    ((wam wam)
+     (register register-index))
+  (setf (%wam-register% wam register)
+        (ecase (wam-mode wam)
+          (:read (wam-heap-cell wam (wam-subterm wam)))
+          (:write (push-unbound-reference! wam))))
+  (incf (wam-subterm wam)))
+
+(define-instructions (%subterm-value-local %subterm-value-stack)
+    ((wam wam)
+     (register register-index))
+  (ecase (wam-mode wam)
+    (:read (unify! wam register (wam-subterm wam)))
+    (:write (wam-heap-push! wam (%wam-register% wam register))))
+  (incf (wam-subterm wam)))
+
+(define-instruction %subterm-void ((wam wam) (n arity))
+  (ecase (wam-mode wam)
+    (:read (incf (wam-subterm wam) n))
+    (:write (repeat n
+              (push-unbound-reference! wam)))))
+
+
 ;;;; Control Instructions
 (define-instruction %call
     ((wam wam)
@@ -663,20 +657,15 @@
 (define-instruction %put-constant ((wam wam)
                                    (constant functor-index)
                                    (register register-index))
-  (setf (wam-local-register wam register)
-        (make-cell-constant constant)))
+  (setf (wam-local-register wam register) (make-cell-constant constant)
+        (wam-mode wam) :write))
 
 (define-instruction %get-constant ((wam wam)
                                    (constant functor-index)
                                    (register register-index))
   (%%match-constant wam constant register))
 
-(define-instruction %set-constant ((wam wam)
-                                   (constant functor-index))
-  (wam-heap-push! wam (make-cell-constant constant))
-  (incf (wam-subterm wam)))
-
-(define-instruction %unify-constant ((wam wam)
+(define-instruction %subterm-constant ((wam wam)
                                      (constant functor-index))
   (ecase (wam-mode wam)
     (:read (%%match-constant wam constant (wam-subterm wam)))
@@ -764,42 +753,37 @@
               (break "About to execute instruction at ~4,'0X" pc))
             (ecase opcode
               ;; Query
-              (#.+opcode-put-structure+        (instruction %put-structure 2))
-              (#.+opcode-set-variable-local+   (instruction %set-variable-local 1))
-              (#.+opcode-set-variable-stack+   (instruction %set-variable-stack 1))
-              (#.+opcode-set-value-local+      (instruction %set-value-local 1))
-              (#.+opcode-set-value-stack+      (instruction %set-value-stack 1))
-              (#.+opcode-set-void+             (instruction %set-void 1))
-              (#.+opcode-put-variable-local+   (instruction %put-variable-local 2))
-              (#.+opcode-put-variable-stack+   (instruction %put-variable-stack 2))
-              (#.+opcode-put-value-local+      (instruction %put-value-local 2))
-              (#.+opcode-put-value-stack+      (instruction %put-value-stack 2))
+              (#.+opcode-put-structure+          (instruction %put-structure 2))
+              (#.+opcode-put-variable-local+     (instruction %put-variable-local 2))
+              (#.+opcode-put-variable-stack+     (instruction %put-variable-stack 2))
+              (#.+opcode-put-value-local+        (instruction %put-value-local 2))
+              (#.+opcode-put-value-stack+        (instruction %put-value-stack 2))
               ;; Program
-              (#.+opcode-get-structure+        (instruction %get-structure 2))
-              (#.+opcode-unify-variable-local+ (instruction %unify-variable-local 1))
-              (#.+opcode-unify-variable-stack+ (instruction %unify-variable-stack 1))
-              (#.+opcode-unify-value-local+    (instruction %unify-value-local 1))
-              (#.+opcode-unify-value-stack+    (instruction %unify-value-stack 1))
-              (#.+opcode-unify-void+           (instruction %unify-void 1))
-              (#.+opcode-get-variable-local+   (instruction %get-variable-local 2))
-              (#.+opcode-get-variable-stack+   (instruction %get-variable-stack 2))
-              (#.+opcode-get-value-local+      (instruction %get-value-local 2))
-              (#.+opcode-get-value-stack+      (instruction %get-value-stack 2))
+              (#.+opcode-get-structure+          (instruction %get-structure 2))
+              (#.+opcode-get-variable-local+     (instruction %get-variable-local 2))
+              (#.+opcode-get-variable-stack+     (instruction %get-variable-stack 2))
+              (#.+opcode-get-value-local+        (instruction %get-value-local 2))
+              (#.+opcode-get-value-stack+        (instruction %get-value-stack 2))
+              ;; Subterm
+              (#.+opcode-subterm-variable-local+ (instruction %subterm-variable-local 1))
+              (#.+opcode-subterm-variable-stack+ (instruction %subterm-variable-stack 1))
+              (#.+opcode-subterm-value-local+    (instruction %subterm-value-local 1))
+              (#.+opcode-subterm-value-stack+    (instruction %subterm-value-stack 1))
+              (#.+opcode-subterm-void+           (instruction %subterm-void 1))
               ;; Constant
-              (#.+opcode-put-constant+         (instruction %put-constant 2))
-              (#.+opcode-get-constant+         (instruction %get-constant 2))
-              (#.+opcode-set-constant+         (instruction %set-constant 1))
-              (#.+opcode-unify-constant+       (instruction %unify-constant 1))
+              (#.+opcode-put-constant+           (instruction %put-constant 2))
+              (#.+opcode-get-constant+           (instruction %get-constant 2))
+              (#.+opcode-subterm-constant+       (instruction %subterm-constant 1))
               ;; List
-              (#.+opcode-put-list+             (instruction %put-list 1))
-              (#.+opcode-get-list+             (instruction %get-list 1))
+              (#.+opcode-put-list+               (instruction %put-list 1))
+              (#.+opcode-get-list+               (instruction %get-list 1))
               ;; Choice
-              (#.+opcode-try+                  (instruction %try 1))
-              (#.+opcode-retry+                (instruction %retry 1))
-              (#.+opcode-trust+                (instruction %trust 0))
-              (#.+opcode-cut+                  (instruction %cut 0))
+              (#.+opcode-try+                    (instruction %try 1))
+              (#.+opcode-retry+                  (instruction %retry 1))
+              (#.+opcode-trust+                  (instruction %trust 0))
+              (#.+opcode-cut+                    (instruction %cut 0))
               ;; Control
-              (#.+opcode-allocate+             (instruction %allocate 1))
+              (#.+opcode-allocate+               (instruction %allocate 1))
               ;; need to skip the PC increment for PROC/CALL/DEAL/DONE
               ;; TODO: this is still ugly
               (#.+opcode-deallocate+