Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv29269
Modified Files: special-operators-cl.lisp Log Message: Added support for pliant protocol for dynamic binding.
Date: Wed Nov 10 18:34:47 2004 Author: ffjeld
Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.28 movitz/special-operators-cl.lisp:1.29 --- movitz/special-operators-cl.lisp:1.28 Thu Oct 21 22:44:52 2004 +++ movitz/special-operators-cl.lisp Wed Nov 10 18:34:47 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:31:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: special-operators-cl.lisp,v 1.28 2004/10/21 20:44:52 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.29 2004/11/10 17:34:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -288,15 +288,14 @@ `((:locally (:movl :esp (:edi (:edi-offset dynamic-env)))))) (if (not recompile-body-p) body-code - (progn #+ignore (warn "recompile..") + (progn #+ignore (warn "recompile..") ; XXX (compile-body))) (when (plusp (num-specials local-env)) `((:movl (:esp ,(+ -4 (* 16 (num-specials local-env)))) :edx) + (:locally (:call (:edi ,(bt:slot-offset 'movitz-run-time-context + 'dynamic-variable-uninstall)))) (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) - (:leal (:esp ,(* 16 (num-specials local-env))) :esp)) - #+ignore - `((:leal (:esp ,(+ -4 (* 16 (num-specials local-env)))) :esp) - (:locally (:popl (:edi (:edi-offset dynamic-env))))))))) + (:leal (:esp ,(* 16 (num-specials local-env))) :esp)))))) (compiler-values (body-values) :returns body-returns :producer (default-compiler-values-producer) @@ -1077,7 +1076,7 @@ values-form :eax funobj env) (with-labels (progv (no-more-symbols no-more-values loop zero-specials)) - `((:xorl :ecx :ecx) ; count number of bindings + `((:xorl :ecx :ecx) ; count number of bindings (fixnum) (:locally (:pushl (:edi (:edi-offset dynamic-env)))) ; first tail (:cmpl :edi :ebx) (:je '(:sub-program (,zero-specials) @@ -1086,7 +1085,7 @@ (:globally (:pushl (:edi (:edi-offset unbound-value)))) ; [[ binding tag ]] (:pushl :edi) ; binding name (:pushl :esp) - (:incl :ecx) + (:addl 4 :ecx) (:jmp ',no-more-symbols))) ,loop (:cmpl :edi :ebx) ; (endp symbols) @@ -1101,21 +1100,30 @@ (:globally (:pushl (:edi (:edi-offset unbound-value)))) ; [[ binding tag ]] (:pushl (:ebx -1)) ; push (car symbols) [[ binding name ]] (:movl (:ebx 3) :ebx) ; (pop symbols) - (:incw :cx) - (:jc '(:sub-program (too-many-symbols) (:int 71))) + (:addl 4 :ecx) + ;; (:jc '(:sub-program (too-many-symbols) (:int 71))) (:pushl :esp) ; push next tail (:jmp ',loop) ,no-more-symbols (:popl :eax) ; remove extra pre-pushed tail (:locally (:movl :esp (:edi (:edi-offset dynamic-env)))) ; install env - ;; ecx = N - (:shll 4 :ecx) ; ecx = 16*N - (:leal (:esp :ecx -4) :eax) ; eax = esp + 16*N - 4 - (:pushl :eax))) ; push address of first binding's tail + ;; ecx = N/fixnum + ;; (:shll 4 :ecx) ; ecx = 16*N + ;; (:leal (:esp :ecx -4) :eax) ; eax = esp + 16*N - 4 + (:pushl :ecx) ; Save number of bindings. + #+ignore (:pushl :eax))) ; push address of first binding's tail body-code (when (eq body-returns :push) `((:popl :eax))) ; glue :push => :eax - `((:popl :esp) ; pop address of first binding's tail + `((:movl (:esp) :edx) ; number of bindings + (:movl (:esp (:edx 4)) :edx) ; previous dynamic-env + (:locally (:call (:edi ,(bt:slot-offset 'movitz-run-time-context + 'dynamic-variable-uninstall)))) + (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) + (:popl :edx) ; number of bindings + (:leal (:esp (:edx 4)) :esp)) + #+ignore + `((:popl :edx) ; pop address of first binding's tail (:locally (:popl (:edi (:edi-offset dynamic-env))))))))))
(define-special-operator labels (&all forward &form form &env env &funobj funobj)