d6b6684d6b7b

--- 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

--- 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))))))

--- 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)