# HG changeset patch # User Steve Losh # Date 1468231100 0 # Node ID d6b6684d6b7b637952b2cde26108a2531fd67257 # Parent 2a7cb53fb03f2da8165975bad907df789adce0b0 Turn `instruction-size` into a neat little lookup table diff -r 2a7cb53fb03f -r d6b6684d6b7b package.lisp --- a/package.lisp Mon Jul 11 09:55:05 2016 +0000 +++ b/package.lisp Mon Jul 11 09:58:20 2016 +0000 @@ -1,4 +1,3 @@ - (defpackage #:bones.utils (:use #:cl @@ -16,6 +15,7 @@ #:unique-items #:dis #:gethash-or-init + #:define-lookup #:make-queue #:enqueue #:dequeue @@ -145,8 +145,6 @@ #:query-all)) - - (defpackage #:bones (:use #:cl #:bones.wam) (:export diff -r 2a7cb53fb03f -r d6b6684d6b7b src/utils.lisp --- a/src/utils.lisp Mon Jul 11 09:55:05 2016 +0000 +++ b/src/utils.lisp Mon Jul 11 09:58:20 2016 +0000 @@ -164,4 +164,52 @@ q) +;;;; Lookup Tables +(defmacro define-lookup + (name (key key-type value-type default) documentation &rest entries) + "Define a lookup function. + This macro defines a function that looks up a result in a constant array. + It's useful for things where you're looking up keys that are small integers, + like opcodes. + + The function should be compiled to a few ASM instructions to read from a bit + of memory in O(1) time, instead of a huge list of CMP instructions that's + O(n) on the number of possibilities. + + `name` should be a symbol that will become the name of the function. It will + be munged to make a name for the constant table too, but you shouldn't mess + with that. + + `key` should be a symbol that will be used as the argument for the lookup + function. `key-type` should be its type and should be a subtype of + (integer 0 some-small-number) if you want this to be efficient. + + `value-type` should be the type of your results. + + `default` should be a value that will be returned from your function if a key + that does not exist is requested. Note that this same `eq` value will always + be returned. + + `entries` should be the list of `(key value)` entries for the table. + + Note that `key`, `default`, and all the keys of `entries` must be + macroexpansion-time constants! + + " + (let ((max (reduce #'max entries :key #'car)) + (entries (apply #'append entries))) + (let ((table (intern (format nil "+~A-TABLE+" name)))) + `(progn + (define-constant ,table + (make-array (1+ ,max) + :element-type ',value-type + :initial-contents + (list ,@(loop :for i :from 0 :to max + :collect (getf entries i default)))) + :test (lambda (x y) (declare (ignore x y)) t)) ; what could go wrong + (declaim (inline ,name)) + (defun* ,name ((,key ,key-type)) + (:returns ,value-type) + ,documentation + (aref ,table ,key)))))) diff -r 2a7cb53fb03f -r d6b6684d6b7b src/wam/bytecode.lisp --- a/src/wam/bytecode.lisp Mon Jul 11 09:55:05 2016 +0000 +++ b/src/wam/bytecode.lisp Mon Jul 11 09:58:20 2016 +0000 @@ -1,60 +1,57 @@ (in-package #:bones.wam) -;;;; Opcodes -(declaim (inline instruction-size)) -(defun* instruction-size ((opcode opcode)) - (:returns (integer 1 3)) +(define-lookup instruction-size (opcode opcode instruction-size 0) "Return the size of an instruction for the given opcode. The size includes one word for the opcode itself and one for each argument. " - (eswitch (opcode) - ;; TODO: make this thing a jump table somehow... - (+opcode-noop+ 1) + (#.+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-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-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-call+ 2) - (+opcode-dynamic-call+ 1) - (+opcode-proceed+ 1) - (+opcode-allocate+ 2) - (+opcode-deallocate+ 1) - (+opcode-done+ 1) - (+opcode-try+ 2) - (+opcode-retry+ 2) - (+opcode-trust+ 1) - (+opcode-cut+ 1) + (#.+opcode-call+ 2) + (#.+opcode-dynamic-call+ 1) + (#.+opcode-proceed+ 1) + (#.+opcode-allocate+ 2) + (#.+opcode-deallocate+ 1) + (#.+opcode-done+ 1) + (#.+opcode-try+ 2) + (#.+opcode-retry+ 2) + (#.+opcode-trust+ 1) + (#.+opcode-cut+ 1) - (+opcode-get-constant+ 3) - (+opcode-set-constant+ 2) - (+opcode-put-constant+ 3) - (+opcode-unify-constant+ 2) + (#.+opcode-get-constant+ 3) + (#.+opcode-set-constant+ 2) + (#.+opcode-put-constant+ 3) + (#.+opcode-unify-constant+ 2) - (+opcode-get-list+ 2) - (+opcode-put-list+ 2))) + (#.+opcode-get-list+ 2) + (#.+opcode-put-list+ 2)) +;;;; Opcodes + (defun* opcode-name ((opcode opcode)) (:returns string) (eswitch (opcode)