[movitz-cvs] CVS update: movitz/compiler.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
Changed dynamic binding lookup protocol. Only use the "unbounded"
primitive-function, and have the caller check whether the value is the
unbound-value or not. And, rename to dynamic-variable-lookup.

Date: Thu Nov 18 18:58:37 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.107 movitz/compiler.lisp:1.108
--- movitz/compiler.lisp:1.107	Wed Nov 17 14:32:46 2004
+++ movitz/compiler.lisp	Thu Nov 18 18:58: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.107 2004/11/17 13:32:46 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.108 2004/11/18 17:58:35 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -5602,7 +5602,11 @@
 	  :modifies nil
 	  :final-form form
 	  :code `((:load-constant ,form :eax)
-		  (:call (:edi ,(global-constant-offset 'dynamic-variable-lookup))))))
+		  (,*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))))))
        (t (check-type binding dynamic-binding)
 	  (compiler-values ()
 	    :returns :eax
@@ -5610,7 +5614,11 @@
 	    :modifies nil
 	    :final-form form
 	    :code `((:load-constant ,form :eax)
-		    (:call (:edi ,(global-constant-offset 'dynamic-variable-lookup))))))))))
+		    (,*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))))))))))
 
 (define-compiler compile-lambda-form (&form form)
   "3.1.2.2.4 Lambda Forms"
@@ -6486,3 +6494,38 @@
 			 `((:movl :eax ,destination))))
 		      (binding
 		       (make-store-lexical destination :eax nil frame-map))))))))))
+
+;;;;;;;
+
+(define-find-read-bindings :eql (x y)
+  (list x y))
+
+(define-extended-code-expander :eql (instruction funobj frame-map)
+  (destructuring-bind (x y)
+      (cdr instruction)
+    (let* ((x-type (apply #'encoded-type-decode (binding-store-type x)))
+	   (y-type (apply #'encoded-type-decode (binding-store-type y)))
+	   (x-singleton (type-specifier-singleton x-type))
+	   (y-singleton (type-specifier-singleton y-type)))
+      (when (and y-singleton (not x-singleton))
+	(rotatef x y)
+	(rotatef x-type y-type)
+	(rotatef x-singleton y-singleton))
+      (warn "eql ~S ~S" x-singleton y-singleton)
+      (cond
+       ((and x-singleton y-singleton)
+	(break "Constant EQL: ~S ~S" (car x-singleton) (car y-singleton)))
+       ((or (movitz-subtypep x-type 'fixnum)
+	    (movitz-subtypep x-type 'character)
+	    (movitz-subtypep y-type 'fixnum)
+	    (movitz-subtypep y-type 'character))
+	(break "EQL that is EQ."))
+       (t (append (make-load-lexical x :eax funobj nil frame-map)
+		  (make-load-lexical y :ebx funobj nil frame-map)
+		  (let ((eql-done (gensym "eql-done-")))
+		    `((:cmpl :eax :ebx)
+		      (:je ',eql-done)
+		      (,*compiler-global-segment-prefix*
+		       :movl (:edi ,(global-constant-offset 'complicated-eql)) :esi)
+		      (:call (:esi ,(bt:slot-offset 'movitz-funobj 'code-vector%2op)))
+		      ,eql-done))))))))