scheme-machineでは，一本のスタックを用いていたが，
リターンアドレスを扱う別のスタックを作るとして次のようなものを考えた．
試してみよ．
(defun scheme-machine (f)
(let* ((code (fn-code f))
(pc 0)
(ra-stack nil)
(env nil)
(stack nil)
(n-args 0)
(instr))
(loop
(setf instr (elt code pc)) ;; fetch
(incf pc)
(case
(car instr)
(lvar (push (lvar instr env) stack))
(lset
(setf (lvar instr env) (car stack)))
(gvar
(push (gvar instr) stack))
(gset
(setf (gvar instr) (car stack)))
(pop (pop stack))
(const (push (arg1 instr) stack))
(jump (setf pc (arg1 instr)))
(fjump (if (null (pop stack))
(setf pc (arg1 instr))))
(tjump (if (pop stack)
(setf pc (arg1 instr))))
(return
(let ((ra (pop ra-stack)))
(setf
f (return-address-fn ra)
code (fn-code f)
env (return-address-env ra)
pc (return-address-pc ra))))
(call
(push (make-return-address
:pc pc :fn f :env env) ra-stack)
(setf f (pop stack)
code (fn-code f)
env (fn-env f)
n-args (arg1 instr)
pc 0))
(args
(push (make-array (arg1 instr)) env)
(do
((i (1- n-args) (1- i)))
((< i 0) nil)
(setf (elt (car env) i) (pop stack))))
(fn
(push (make-fn :code (fn-code (arg1 instr))
:env env)
stack))
(prim
(let ((args nil))
(dotimes (i n-args) (push (pop stack) args))
(push (apply (arg1 instr) args)
stack)
))
(otherwise (error "unknown opcode: ~a" instr))
)))
)
