Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv20233

Modified Files: compiler.lisp Log Message: Changed the way the unbound value is checked for at dynamic lookup: If the unbound-value is #x7fffffff, we can make and unbound variable trigger an exception like this: (:cmpl -1 :eax) (:into).

Date: Sun Nov 21 13:30:36 2004 Author: ffjeld

Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.114 movitz/compiler.lisp:1.115 --- movitz/compiler.lisp:1.114 Sat Nov 20 18:43:13 2004 +++ movitz/compiler.lisp Sun Nov 21 13:30:35 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.114 2004/11/20 17:43:13 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.115 2004/11/21 12:30:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -65,6 +65,9 @@ the system ensures one way or another that there can be no pointers below this size.")

+(defvar *compiler-use-into-unbound-protocol* t + "Use #x7fffffff as the <unbound-value> and thereby the INTO +instruction for checking whether a value is the unbound value.")

(defvar *compiler-compile-eval-whens* t "When encountering (eval-when (:compile-toplevel) <code>), @@ -5614,24 +5617,42 @@ :functional-p t :modifies nil :final-form form - :code `((:load-constant ,form :eax) - (,*compiler-local-segment-prefix* - :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) - (,*compiler-local-segment-prefix* - :cmpl :eax (:edi ,(global-constant-offset 'unbound-value))) - (:je '(:sub-program () (:int 99)))))) + :code (if *compiler-use-into-unbound-protocol* + `((:load-constant ,form :ebx) + (,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) + (:cmpl -1 :eax) + (:into)) + (let ((not-unbound (gensym "not-unbound-"))) + `((:load-constant ,form :ebx) + (,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) + (,*compiler-local-segment-prefix* + :cmpl :eax (:edi ,(global-constant-offset 'unbound-value))) + (:jne ',not-unbound) + (:int 99) + ,not-unbound))))) (t (check-type binding dynamic-binding) (compiler-values () :returns :eax :functional-p t :modifies nil :final-form form - :code `((:load-constant ,form :eax) - (,*compiler-local-segment-prefix* - :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) - (,*compiler-local-segment-prefix* - :cmpl :eax (:edi ,(global-constant-offset 'unbound-value))) - (:je '(:sub-program () (:int 99)))))))))) + :code (if *compiler-use-into-unbound-protocol* + `((:load-constant ,form :ebx) + (,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) + (:cmpl -1 :eax) + (:into)) + (let ((not-unbound (gensym "not-unbound-"))) + `((:load-constant ,form :ebx) + (,*compiler-local-segment-prefix* + :call (:edi ,(global-constant-offset 'dynamic-variable-lookup))) + (,*compiler-local-segment-prefix* + :cmpl :eax (:edi ,(global-constant-offset 'unbound-value))) + (:jne ',not-unbound) + (:int 99) + ,not-unbound)))))))))

(define-compiler compile-lambda-form (&form form) "3.1.2.2.4 Lambda Forms"