Commit b8a13ab0 authored by  Hayley Patton's avatar Hayley Patton 🐢

Fix order of arguments on function calls in the script machine

parent 37ba9ba7
......@@ -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))))
......
......@@ -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
......
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