diff options
| author | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-15 00:24:17 +0200 |
|---|---|---|
| committer | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-15 00:24:17 +0200 |
| commit | ed8c2eb04279c1d974abecc0c6715ab464eac66f (patch) | |
| tree | bb2ab7191bac88b6dffb8747e00573de8f283832 /sb-eval2.lisp | |
| parent | f5d2a0cffe4762e1b793e0490903fdc6ec15b648 (diff) | |
Establish stacks as necessary.
Diffstat (limited to 'sb-eval2.lisp')
| -rw-r--r-- | sb-eval2.lisp | 36 |
1 files changed, 21 insertions, 15 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp index 20b57ca..610ad50 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -213,12 +213,22 @@ (setq env (environment-parent env))) (setf (svref (environment-data env) offset) val)) +(defmacro with-stack (() &body body) + `(call-with-stack (lambda () ,@body))) + +(declaim (inline call-with-stack)) +(defun call-with-stack (thunk) + (let ((*stack* (make-array '(10000))) + (*fp* 0) + (*sp* 0)) + (funcall thunk))) + (defmacro with-stack-frame (nvars &body body) `(call-with-stack-frame ,nvars (lambda () ,@body))) -(declaim (ftype (function (fixnum function) *) call-with-stack-frame) - (inline call-with-stack-frame)) -(defun call-with-stack-frame (nvars thunk) +(declaim (ftype (function (fixnum function) *) really-call-with-stack-frame) + (inline really-call-with-stack-frame)) +(defun really-call-with-stack-frame (nvars thunk) (let* ((stack *stack*) (sp *sp*) (new-size (+ sp nvars 1))) @@ -237,6 +247,13 @@ (*sp* new-size)) (funcall thunk)))) +(declaim (ftype (function (fixnum function) *) call-with-stack-frame) + (inline call-with-stack-frame)) +(defun call-with-stack-frame (nvars thunk) + (if (boundp '*stack*) + (really-call-with-stack-frame nvars thunk) + (with-stack () (really-call-with-stack-frame nvars thunk)))) + (declaim (ftype (function (fixnum) *) deref-stack) (inline deref-stack)) (defun deref-stack (pos) @@ -790,19 +807,8 @@ (prepare-global-call f args context)))))))))))) t)) - -(defmacro with-stack (() &body body) - `(call-with-stack (lambda () ,@body))) - -(defun call-with-stack (thunk) - (let ((*stack* (make-array '(10000))) - (*fp* 0) - (*sp* 0)) - (funcall thunk))) - (defun eval (form) - (with-stack () - (funcall (prepare-form form) (make-null-environment)))) + (funcall (prepare-form form) (make-null-environment))) (defun load (filename) |