Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Hayley Patton
netfarm
Commits
1c4df956
Commit
1c4df956
authored
Feb 04, 2020
by
Hayley Patton
🐢
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add case-discriminator-function for discussion
parent
7c0e00f0
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
50 additions
and
0 deletions
+50
-0
Code/Scripts/case-discriminator-function.lisp
Code/Scripts/case-discriminator-function.lisp
+50
-0
No files found.
Code/Scripts/case-discriminator-function.lisp
0 → 100644
View file @
1c4df956
(
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
collect
`
(
,
position
,
(
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
))))
,@
declarations
,
body
(
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
))
(
loop
(
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
))
(
tagbody
(
case
opcode
.
,
(
make-discriminator-parts
*operators*
))
lose
(
error
"illegal opcode ~d on ~s"
opcode
interpreter
)
out
(
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"
))))))))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment