Commit 1c4df956 authored by  Hayley Patton's avatar Hayley Patton 🐢

Add case-discriminator-function for discussion

parent 7c0e00f0
(in-package :netfarm-scripts)
;;; scymtym suggested SBCL's CASE might be faster now as it uses perfect
;;; hashing and a jump table to dispatch.
;;; This is a hair slower than
(defun make-discriminator-parts (operator-table)
(loop for operator across operator-table
for position from 0
,(if (eq operator (aref operator-table 255))
`(go lose)
(destructuring-bind ((interpreter inputs bytes) declarations body)
(aref *opcode-code* position)
`(let ((,interpreter interpreter))
(let (,@(loop for input in (reverse inputs)
collect `(,input (pop* (interpreter-data-stack ,interpreter))))
,@(loop for byte in bytes
collect `(,byte (interpreter-read-byte ,interpreter))))
(go out))))))))
(defun make-discriminator-function ()
(compile nil
`(lambda (interpreter cons-limit cycle-limit)
(declare (optimize (speed 3) (safety 1))
(interpreter interpreter)
((or null fixnum) cons-limit cycle-limit)
#+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note))
(let ((opcode (aref (interpreter-program interpreter)
(interpreter-program-counter interpreter))))
(declare ((unsigned-byte 8) opcode))
(incf (interpreter-instruction-count interpreter))
(incf (interpreter-program-counter interpreter))
(case opcode . ,(make-discriminator-parts *operators*))
(error "illegal opcode ~d on ~s"
opcode interpreter)
(when (and (not (null cons-limit))
(> (interpreter-cons-count interpreter) cons-limit))
(error "exceeded cons limit"))
(when (and (not (null cycle-limit))
(> (interpreter-instruction-count interpreter) cycle-limit))
(error "exceeded cycle limit"))))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment