Commit 2b52385e authored by  Hayley Patton's avatar Hayley Patton 🐢

Update the CASE discriminator function

parent b8a13ab0
......@@ -3,26 +3,26 @@
;;; scymtym suggested SBCL's CASE might be faster now as it uses perfect
;;; hashing and a jump table to dispatch.
(defun make-discriminator-parts (operator-table start end)
`(case opcode
. ,(loop for position from start below end
for operator = (aref operator-table position)
collect
`(,position
,(if (null (aref *opcode-code* position))
`(go lose)
(destructuring-bind ((parts inputs bytes) declarations body)
(aref *opcode-code* position)
`(with-interpreter-parts-renamed (data-stack %%data-stack
program-counter %%program-counter
program %%program
. ,parts)
(let (,@(loop for input in (reverse inputs)
collect `(,input (pop* %%data-stack)))
,@(loop for byte in bytes
for position from 0
collect `(,byte (aref %%program (+ ,position %%program-counter)))))
,@declarations
(incf %%program-counter ,(length bytes))
,body
(go out)))))))))
(defun make-discriminator-code ()
`(tagbody
(ecase opcode
. ,(loop for position below 256
collect
`(,position
,(if (null (aref *opcode-code* position))
`(go lose)
(destructuring-bind ((parts inputs bytes) declarations body)
(aref *opcode-code* position)
`(with-interpreter-parts-renamed (data-stack %%data-stack
program-counter %%program-counter
program %%program
. ,parts)
(let (,@(loop for input in (reverse inputs)
collect `(,input (pop* %%data-stack)))
,@(loop for byte in bytes
for position from 0
collect `(,byte (aref %%program (+ ,position %%program-counter)))))
,@declarations
(incf %%program-counter ,(length bytes))
,body
(go out))))))))))
......@@ -87,7 +87,7 @@
(defun make-discriminator-function ()
(compile nil
`(lambda (interpreter cons-limit cycle-limit)
`(lambda (interpreter cons-limit cycle-limit)
(declare (optimize (speed 3) (safety 1)
(debug 0))
(interpreter interpreter)
......
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