# HG changeset patch # User Steve Losh # Date 1468160478 0 # Node ID ba205f6b2875d04e69f4a26f1c31819d8548de8e # Parent 07e1d5f315f5ff2b1118a65a760893cbf6a430bc Excise the stupid fucking `set-*` opcodes The book uses the horribly-confusingly-named `set-*` operations for handling subterms in query mode. The author does this because he claims this is both easier to understand and more performant. In reality it is neither of these things. If you just name the subterm-handling opcodes something not completely stupid, like `handle-subterm-*` instead of `unify-*` it becomes obvious what they do. Also, despite the fact that `put-*` instructions now need to set the WAM's `mode`, we still get about a 10% speedup here, likely from some combination of reducing the VM loop code size and simplifying the compilation process. So it's not even more performant. TL;DR: Just say "No" to `set-*`. diff -r 07e1d5f315f5 -r ba205f6b2875 examples/bench.lisp --- a/examples/bench.lisp Sat Jul 09 21:51:02 2016 +0000 +++ b/examples/bench.lisp Sun Jul 10 14:21:18 2016 +0000 @@ -22,8 +22,8 @@ ; (format t "PAIP (Compiled) --------------------~%") ; (time (paiprolog-test::dfs-exhaust)) - (format t "PAIP (Interpreted) -----------------~%") - (time (bones.paip::depth-first-search :exhaust t)) + ; (format t "PAIP (Interpreted) -----------------~%") + ; (time (bones.paip::depth-first-search :exhaust t)) (format t "WAM --------------------------------~%") (time (bones.wam::depth-first-search :exhaust t))) diff -r 07e1d5f315f5 -r ba205f6b2875 src/wam/bytecode.lisp --- a/src/wam/bytecode.lisp Sat Jul 09 21:51:02 2016 +0000 +++ b/src/wam/bytecode.lisp Sun Jul 10 14:21:18 2016 +0000 @@ -14,27 +14,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-unify-variable-local+ 2) + (+opcode-unify-variable-stack+ 2) + (+opcode-unify-value-local+ 2) + (+opcode-unify-value-stack+ 2) + (+opcode-unify-void+ 2) + (+opcode-call+ 2) (+opcode-dynamic-call+ 1) (+opcode-proceed+ 1) @@ -47,7 +43,6 @@ (+opcode-cut+ 1) (+opcode-get-constant+ 3) - (+opcode-set-constant+ 2) (+opcode-put-constant+ 3) (+opcode-unify-constant+ 2) @@ -59,28 +54,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-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-call+ "CALL") (+opcode-dynamic-call+ "DYNAMIC-CALL") (+opcode-proceed+ "PROCEED") @@ -93,7 +85,6 @@ (+opcode-cut+ "CUT") (+opcode-get-constant+ "GET-CONSTANT") - (+opcode-set-constant+ "SET-CONSTANT") (+opcode-put-constant+ "PUT-CONSTANT") (+opcode-unify-constant+ "UNIFY-CONSTANT") @@ -106,27 +97,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-unify-variable-local+ "UVAR") + (+opcode-unify-variable-stack+ "UVAR") + (+opcode-unify-value-local+ "UVLU") + (+opcode-unify-value-stack+ "UVLU") + (+opcode-unify-void+ "UVOI") + (+opcode-call+ "CALL") (+opcode-dynamic-call+ "DYCL") (+opcode-proceed+ "PROC") @@ -139,7 +126,6 @@ (+opcode-cut+ "CUTT") (+opcode-get-constant+ "GCON") - (+opcode-set-constant+ "SCON") (+opcode-put-constant+ "PCON") (+opcode-unify-constant+ "UCON") diff -r 07e1d5f315f5 -r ba205f6b2875 src/wam/compiler.lisp --- a/src/wam/compiler.lisp Sat Jul 09 21:51:02 2016 +0000 +++ b/src/wam/compiler.lisp Sun Jul 10 14:21:18 2016 +0000 @@ -883,11 +883,11 @@ ;;; into a list of instructions, each of which is a list: ;;; ;;; (:put-structure X2 q 2) -;;; (:set-variable X1) -;;; (:set-variable X3) +;;; (:unify-variable X1) +;;; (:unify-variable X3) ;;; (:put-structure X0 p 2) -;;; (:set-value X1) -;;; (:set-value X2) +;;; (:unify-value X1) +;;; (:unify-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. @@ -995,24 +995,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 :unify-variable-local) + (:stack :unify-variable-stack) + (:void :unify-void)) + (case register-variant + (:local :unify-value-local) + (:stack :unify-value-stack) + (:void :unify-void))))))) (defun precompile-tokens (wam head-tokens body-tokens) @@ -1081,11 +1071,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 @@ -1264,24 +1254,24 @@ ;; 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-unify-constant-query (node constant register) ;; 3. put_structure c/0, Xi *** WE ARE HERE ;; ... - ;; set_value Xi -> set_constant c + ;; unify_value Xi -> unify_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 :unify-value-local) (register= register (first arguments))) :do - (circle-replace n `(:set-constant ,constant)) + (circle-replace n `(:unify-constant ,constant)) (return previous))) -(defun optimize-unify-constant (node constant register) - ;; 4. unify_variable Xi -> unify_constant c +(defun optimize-unify-constant-program (node constant register) + ;; 4. unify_variable Xi -> unify_constant c ;; ... ;; get_structure c/0, Xi *** WE ARE HERE (loop @@ -1311,14 +1301,14 @@ (setf node (if (register-argument-p register) (optimize-put-constant node functor register) - (optimize-set-constant node functor register)))) + (optimize-unify-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-unify-constant-program node functor register)))))) instructions)) @@ -1360,28 +1350,22 @@ (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+) + (: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+) (: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+) diff -r 07e1d5f315f5 -r ba205f6b2875 src/wam/constants.lisp --- a/src/wam/constants.lisp Sat Jul 09 21:51:02 2016 +0000 +++ b/src/wam/constants.lisp Sun Jul 10 14:21:18 2016 +0000 @@ -115,11 +115,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+ @@ -127,16 +122,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-unify-variable-local+ + +opcode-unify-variable-stack+ + +opcode-unify-value-local+ + +opcode-unify-value-stack+ + +opcode-unify-void+ + ;; Control +opcode-call+ +opcode-dynamic-call+ @@ -151,7 +148,6 @@ ;; Constants +opcode-get-constant+ - +opcode-set-constant+ +opcode-put-constant+ +opcode-unify-constant+ diff -r 07e1d5f315f5 -r ba205f6b2875 src/wam/dump.lisp --- a/src/wam/dump.lisp Sat Jul 09 21:51:02 2016 +0000 +++ b/src/wam/dump.lisp Sun Jul 10 14:21:18 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,11 +232,6 @@ (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" (pretty-arguments arguments) diff -r 07e1d5f315f5 -r ba205f6b2875 src/wam/vm.lisp --- a/src/wam/vm.lisp Sat Jul 09 21:51:02 2016 +0000 +++ b/src/wam/vm.lisp Sun Jul 10 14:21:18 2016 +0000 @@ -340,28 +340,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) @@ -369,14 +360,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 @@ -452,6 +444,21 @@ (t (backtrack! wam))))) +(define-instructions (%get-variable-local %get-variable-stack) + ((wam wam) + (register register-index) + (argument register-index)) + (setf (%wam-register% wam register) + (wam-local-register wam argument))) + +(define-instructions (%get-value-local %get-value-stack) + ((wam wam) + (register register-index) + (argument register-index)) + (unify! wam register argument)) + + +;;;; Subterm Instructions (define-instructions (%unify-variable-local %unify-variable-stack) ((wam wam) (register register-index)) @@ -475,19 +482,6 @@ (:write (repeat n (push-unbound-reference! wam))))) -(define-instructions (%get-variable-local %get-variable-stack) - ((wam wam) - (register register-index) - (argument register-index)) - (setf (%wam-register% wam register) - (wam-local-register wam argument))) - -(define-instructions (%get-value-local %get-value-stack) - ((wam wam) - (register register-index) - (argument register-index)) - (unify! wam register argument)) - ;;;; Control Instructions (define-instruction %call ((wam wam) (functor functor-index) @@ -652,19 +646,14 @@ (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) (constant functor-index)) (ecase (wam-mode wam) @@ -754,30 +743,25 @@ (eswitch (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)) ;; Program (+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-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)) ;; 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)) ;; List (+opcode-put-list+ (instruction %put-list 1))