[movitz-cvs] CVS update: movitz/special-operators-cl.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Fri Sep 17 11:12:47 UTC 2004
Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv6262
Modified Files:
special-operators-cl.lisp
Log Message:
Re-working of non-local control transfer so as to comply with the
stack discipline.
Date: Fri Sep 17 13:12:47 2004
Author: ffjeld
Index: movitz/special-operators-cl.lisp
diff -u movitz/special-operators-cl.lisp:1.23 movitz/special-operators-cl.lisp:1.24
--- movitz/special-operators-cl.lisp:1.23 Wed Sep 15 12:22:52 2004
+++ movitz/special-operators-cl.lisp Fri Sep 17 13:12: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.23 2004/09/15 10:22:52 ffjeld Exp $
+;;;; $Id: special-operators-cl.lisp,v 1.24 2004/09/17 11:12:47 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -291,6 +291,10 @@
(progn #+ignore (warn "recompile..")
(compile-body)))
(when (plusp (num-specials local-env))
+ `((:movl (:esp ,(+ -4 (* 16 (num-specials local-env)))) :edx)
+ (: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)))))))))
(compiler-values (body-values)
@@ -1183,48 +1187,90 @@
(:locally (:movl :esp (:edi (:edi-offset dynamic-env))))) ; install catch
body-code
`(,exit-point
+ (:movl (:esp 12) :edx)
+ (:locally (:movl :edx (:edi (:edi-offset dynamic-env))))
(:popl :ebp)
- (:leal (:esp 8) :esp) ; Skip catch-tag and jumper
- (:locally (:popl (:edi (:edi-offset dynamic-env)))))))))
+ (:leal (:esp 12) :esp)
+ )))))
(define-special-operator unwind-protect (&all all &form form &env env)
(destructuring-bind (protected-form &body cleanup-forms)
(cdr form)
- (let ((up-env (make-instance 'unwind-protect-env
- :uplink env
- :funobj (movitz-environment-funobj env))))
- (with-labels (unwind-protect (cleanup-label cleanup-entry))
- (compiler-call #'compile-form
- :result-mode :multiple-values
- :forward all
- :form `(muerte.cl::multiple-value-prog1
- (muerte::with-progn-results (:ignore :multiple-values)
- (muerte::with-inline-assembly-case ()
- (do-case (t :multiple-values)
- ;; install up dynamic-env..
- (:locally (:pushl (:edi (:edi-offset dynamic-env))))
- (:declare-label-set ,cleanup-label (,cleanup-entry))
- (:pushl ',cleanup-label) ; jumper index
- (:globally (:pushl (:edi (:edi-offset unwind-protect-tag)))) ; tag
- (:pushl :ebp) ; stack-frame
- (:locally (:movl :esp (:edi (:edi-offset dynamic-env)))))) ; install up-env
- (muerte::with-local-env (,up-env)
- ,protected-form)
- (muerte::with-inline-assembly-case ()
- (do-case (t :multiple-values)
- ;; uninstall dynamic-env..
- (:leal (:esp ,(- 16 4)) :esp)
- (:locally (:popl (:edi (:edi-offset dynamic-env)))))))
- (muerte::with-inline-assembly-case ()
- (do-case (t :nothing)
- ;; execute cleanup-forms
- (:call '(:sub-program (,cleanup-entry) ; label
- ,@(compiler-call #'compile-form
- :with-stack-used t ; stack distance is _really_ unknown!
- :defaults all
- :result-mode :ignore
- :form `(muerte.cl::progn , at cleanup-forms))
- (:ret)))))))))))
+ (let* ((continuation-env (make-instance 'let-env
+ :uplink env
+ :funobj (movitz-environment-funobj env)))
+ (next-continuation-step-binding
+ (movitz-env-add-binding continuation-env
+ (make-instance 'located-binding
+ :name (gensym "up-next-continuation-step-"))))
+ (unwind-protect-env (make-instance 'unwind-protect-env
+ :uplink continuation-env
+ :funobj (movitz-environment-funobj env))))
+ (with-labels (unwind-protect (cleanup-label cleanup-entry continue continue-label))
+ (compiler-values ()
+ :returns :multiple-values
+ :code (append
+ ;; install default continuation dynamic-env..
+ `((:locally (:pushl (:edi (:edi-offset dynamic-env)))) ; uplink
+ (:declare-label-set ,continue-label (,continue))
+ (:pushl ',continue-label)
+ (:locally (:pushl (:edi (:edi-offset unbound-value))))
+ (:pushl :ebp)
+ (:locally (:movl :esp (:edi (:edi-offset dynamic-env)))))
+ ;; install unwind-protect dynamic-env..
+ `((:locally (:pushl (:edi (:edi-offset dynamic-env))))
+ (:declare-label-set ,cleanup-label (,cleanup-entry))
+ (:pushl ',cleanup-label) ; jumper index
+ (:globally (:pushl (:edi (:edi-offset unwind-protect-tag)))) ; tag
+ (:pushl :ebp) ; stack-frame
+ (:locally (:movl :esp (:edi (:edi-offset dynamic-env))))) ; install up-env
+ ;; Execute protected form..
+ (compiler-call #'compile-form
+ :env unwind-protect-env
+ :with-stack-used t
+ :forward all
+ :result-mode :multiple-values
+ :form protected-form)
+ ;; From now on, take care not to touch current-values from protected-form.
+ `((:leal (:esp 16) :edx) ; default final continuation
+ (:locally (:movl :edx (:edi (:edi-offset raw-scratch0))))
+ ,cleanup-entry
+ (:movl (:esp 12) :edx) ; pop out of unwind-protect
+ (:locally (:movl :edx (:edi (:edi-offset dynamic-env))))
+ (:popl :ebp)
+ (:leal (:esp 12) :esp)
+ (:locally (:pushl (:edi (:edi-offset raw-scratch0))))) ; push final-continuation
+ ;; Execute cleanup-forms.
+ (compiler-call #'compile-form-unprotected
+ :forward all
+ :env continuation-env
+ :with-stack-used t
+ :result-mode :multiple-values
+ :form `(muerte::with-cloak (:multiple-values)
+ ;; Inside here we don't have to mind current-values.
+ (muerte::with-inline-assembly (:returns :nothing)
+ ;; First, find next-continuation-step..
+ (:locally (:movl (:edi (:edi-offset raw-scratch0)) :eax)) ; final-cont..
+ (:locally (:call (:edi (:edi-offset dynamic-unwind-next))))
+ (:locally (:bound (:edi (:edi-offset stack-bottom)) :eax))
+ (:store-lexical ,next-continuation-step-binding :eax :type t))
+ , at cleanup-forms))
+ `((:load-lexical ,next-continuation-step-binding :edx)
+ (:locally (:popl (:edi (:edi-offset raw-scratch0)))) ; pop final continuation
+ (:locally (:movl :esi (:edi (:edi-offset scratch1))))
+ (:locally (:movl :edx (:edi (:edi-offset dynamic-env))))
+ (:movl :edx :esp) ; enter non-local jump stack mode (possibly).
+
+ (:movl (:esp) :edx) ; target stack-frame EBP
+ (:movl (:edx -4) :esi) ; get target funobj into EDX
+
+ (:movl (:esp 8) :edx) ; target jumper number
+ (:jmp (:esi :edx ,(slot-offset 'movitz-funobj 'constant0))))
+ `(,continue
+ (:movl (:esp 12) :edx)
+ (:locally (:movl :edx (:edi (:edi-offset dynamic-env))))
+ (:popl :ebp)
+ (:leal (:esp 12) :esp))))))))
(define-special-operator if (&all all &form form &env env &result-mode result-mode)
More information about the Movitz-cvs
mailing list