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
b8a13ab0
Commit
b8a13ab0
authored
Mar 22, 2020
by
Hayley Patton
🐢
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fix order of arguments on function calls in the script machine
parent
37ba9ba7
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
19 additions
and
17 deletions
+19
-17
Code/Scripts/Script-machine/control-flow.lisp
Code/Scripts/Script-machine/control-flow.lisp
+15
-13
Tests/benchmark.lisp
Tests/benchmark.lisp
+4
-4
No files found.
Code/Scripts/Script-machine/control-flow.lisp
View file @
b8a13ab0
...
...
@@ -18,11 +18,11 @@
(
defun
make-frame
(
interpreter
frame-size
)
(
let
((
frame
(
make-array
frame-size
)))
(
dotimes
(
n
frame-size
)
(
when
(
null
(
interpreter-data-stack
interpreter
))
(
error
"out of data when creating frame"
)
)
(
setf
(
aref
frame
n
)
(
pop
(
interpreter-data-stack
interpreter
))))
(
loop
for
n
from
(
1-
frame-size
)
downto
0
when
(
null
(
interpreter-data-stack
interpreter
))
do
(
error
"out of data when creating frame"
)
do
(
setf
(
aref
frame
n
)
(
pop
(
interpreter-data-stack
interpreter
))))
frame
))
;;; Control flow
...
...
@@ -53,10 +53,11 @@
(
procedure-arguments
function
)
argument-count
)
(
push
(
vector
environment
program-counter
)
call-stack
)
(
let
((
new-frame
(
make-array
argument-count
)))
(
dotimes
(
n
argument-count
)
(
when
(
null
data-stack
)
(
error
"out of data when creating frame"
))
(
setf
(
aref
new-frame
n
)
(
pop
data-stack
)))
(
loop
for
n
from
(
1-
argument-count
)
downto
0
when
(
null
data-stack
)
do
(
error
"out of data when creating frame"
)
do
(
setf
(
aref
new-frame
n
)
(
pop
data-stack
)))
(
setf
environment
(
cons
new-frame
environment
)
program-counter
(
procedure-entry-point
function
))))
...
...
@@ -76,10 +77,11 @@
"wanted ~d argument~:p but got ~d"
(
procedure-arguments
function
)
argument-count
)
(
let
((
new-frame
(
make-array
argument-count
)))
(
dotimes
(
n
argument-count
)
(
when
(
null
data-stack
)
(
error
"out of data when creating frame"
))
(
setf
(
aref
new-frame
n
)
(
pop
data-stack
)))
(
loop
for
n
from
(
1-
argument-count
)
downto
0
when
(
null
data-stack
)
do
(
error
"out of data when creating frame"
)
do
(
setf
(
aref
new-frame
n
)
(
pop
data-stack
)))
(
setf
environment
(
cons
new-frame
environment
)
program-counter
(
procedure-entry-point
function
))))
...
...
Tests/benchmark.lisp
View file @
b8a13ab0
...
...
@@ -93,11 +93,11 @@
(
netfarm-scripts:define-script
*cons-loop*
(
"bloop"
)
(
:procedure
2
)
(
get-env
0
0
)
(
byte
0
)
=
(
get-env
1
0
)
(
byte
0
)
=
(
jump-cond
0
0
0
4
)
(
get-env
1
0
)
return
(
get-value
0
)
(
get-env
1
0
)
cons
(
get-env
0
0
)
(
byte
1
)
-
(
get-env
0
0
)
return
(
get-value
0
)
(
get-env
0
0
)
cons
(
get-env
1
0
)
(
byte
1
)
-
(
get-proc*
0
)
(
tail-call
2
))
(
define-test
script-machine-benchmark
...
...
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