diff options
| -rw-r--r-- | sb-eval2.lisp | 28 |
1 files changed, 15 insertions, 13 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp index af29739..6ba0ad6 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -10,9 +10,10 @@ (defvar *stack*) (defvar *fp*) +(defvar *sp*) (deftype stack () - `(array t (*))) + 'simple-vector) (defstruct (environment (:constructor make-environment (parent &optional (size 0) @@ -219,7 +220,7 @@ (inline call-with-stack-frame)) (defun call-with-stack-frame (nvars thunk) (let* ((stack *stack*) - (sp (fill-pointer stack)) + (sp *sp*) (new-size (+ sp nvars 1))) (declare (type stack stack) (type fixnum sp new-size)) @@ -227,16 +228,16 @@ while (< size new-size) do (format t "~&Resizing stack (new size: ~D)." (+ new-size (the fixnum (round (* size 1.5))))) - (adjust-array stack - (list (the fixnum - (+ new-size (the fixnum - (round (* size 1.5)))))))) - (setf (fill-pointer stack) new-size) + (setq stack + (adjust-array stack + (list (the fixnum + (+ new-size (the fixnum + (round (* size 1.5)))))))) + (setq *stack* stack)) (setf (aref stack sp) (the fixnum *fp*)) - (unwind-protect - (let ((*fp* sp)) - (funcall thunk)) - (setf (fill-pointer stack) sp)))) + (let ((*fp* sp) + (*sp* new-size)) + (funcall thunk)))) (declaim (ftype (function (fixnum) *) deref-stack) (inline deref-stack)) @@ -796,8 +797,9 @@ `(call-with-stack (lambda () ,@body))) (defun call-with-stack (thunk) - (let ((*stack* (make-array '(2000) :fill-pointer t :adjustable t)) - (*fp* 0)) + (let ((*stack* (make-array '(10000))) + (*fp* 0) + (*sp* 0)) (funcall thunk))) (defun eval (form) |