diff options
| author | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-18 14:05:56 +0200 |
|---|---|---|
| committer | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-18 14:05:56 +0200 |
| commit | fdaed368bc089166f8936318a163c43f64d9532a (patch) | |
| tree | c2e81ebd534a75a3e7880c54e3fd3f2da2f7b9c1 | |
| parent | 98ad36db6286960152b38d4d47a710b220cf808e (diff) | |
Stack allocation: Limit size, simplify code.
| -rw-r--r-- | sb-eval2.lisp | 26 |
1 files changed, 12 insertions, 14 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp index 816e462..cb908b2 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -8,7 +8,7 @@ ;;(declaim (optimize (debug 3) (space 0) (speed 0) (safety 3) (compilation-speed 0))) (declaim (optimize (debug 0) (space 0) (speed 3) (safety 0) (compilation-speed 0))) -(defconstant +stack-max+ 1000) +(defconstant +stack-max+ 8) (defmacro specialize (&environment env var value possible-values &body body) `(ecase ,value @@ -669,12 +669,11 @@ special-bindings* specials)) (let ((body* (prepare-progn body new-context)) (special-vars (mapcar #'car special-bindings*)) - (special-vals* (mapcar #'cdr special-bindings*)) - (n (length (the list lexical-values*)))) + (special-vals* (mapcar #'cdr special-bindings*))) (if envp (lambda (env) - (let ((new-env (make-environment env n))) - (loop for i from 0 below n + (let ((new-env (make-environment env varnum))) + (loop for i from 0 below varnum for val* in lexical-values* do (setf (environment-value new-env 0 i) (funcall (the eval-closure val*) env))) @@ -682,10 +681,10 @@ special-vars (loop for val* in special-vals* collect (funcall (the eval-closure val*) env)) - (funcall body* new-env)))) + (funcall body* new-env)))) (lambda (env) - (with-dynamic-extent-environment (new-env env n) - (loop for i from 0 below n + (with-dynamic-extent-environment (new-env env varnum) + (loop for i from 0 below varnum for val* in lexical-values* do (setf (environment-value new-env 0 i) (funcall (the eval-closure val*) env))) @@ -722,12 +721,11 @@ special-bindings* specials)) (let ((body* (prepare-progn body new-context)) (special-vars (mapcar #'car special-bindings*)) - (special-vals* (mapcar #'cdr special-bindings*)) - (n (length (the list lexical-values*)))) + (special-vals* (mapcar #'cdr special-bindings*))) (if envp (lambda (env) - (let ((new-env (make-environment env n))) - (loop for i from 0 below n + (let ((new-env (make-environment env varnum))) + (loop for i from 0 below varnum for val* in lexical-values* do (setf (environment-value new-env 0 i) (funcall (the eval-closure val*) new-env))) @@ -737,8 +735,8 @@ collect (funcall (the eval-closure val*) new-env)) (funcall body* new-env)))) (lambda (env) - (with-dynamic-extent-environment (new-env env n) - (loop for i from 0 below n + (with-dynamic-extent-environment (new-env env varnum) + (loop for i from 0 below varnum for val* in lexical-values* do (setf (environment-value new-env 0 i) (funcall (the eval-closure val*) new-env))) |