Turn `instruction-size` into a neat little lookup table
author |
Steve Losh <steve@stevelosh.com> |
date |
Mon, 11 Jul 2016 09:58:20 +0000 |
parents |
2a7cb53fb03f
|
children |
7bd5fdb2151d
|
branches/tags |
(none) |
files |
package.lisp src/utils.lisp src/wam/bytecode.lisp |
Changes
--- 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)