Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Hayley Patton
netfarm
Commits
2b52385e
Commit
2b52385e
authored
Apr 01, 2020
by
Hayley Patton
🐢
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Update the CASE discriminator function
parent
b8a13ab0
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
24 additions
and
24 deletions
+24
-24
Code/Scripts/Script-machine/case-discriminator-function.lisp
Code/Scripts/Script-machine/case-discriminator-function.lisp
+23
-23
Code/Scripts/Script-machine/discriminator-function.lisp
Code/Scripts/Script-machine/discriminator-function.lisp
+1
-1
No files found.
Code/Scripts/Script-machine/case-discriminator-function.lisp
View file @
2b52385e
...
...
@@ -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
opc
od
e
.
,
(
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
(
)
`
(
tagb
od
y
(
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
)))))))))
)
Code/Scripts/Script-machine/discriminator-function.lisp
View file @
2b52385e
...
...
@@ -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
)
...
...
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