[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	memref.lisp 
Log Message:
Fix the (setf memref-int) compiler-macro to observe register discipline.

Date: Thu Sep  2 11:38:46 2004
Author: ffjeld

Index: movitz/losp/muerte/memref.lisp
diff -u movitz/losp/muerte/memref.lisp:1.27 movitz/losp/muerte/memref.lisp:1.28
--- movitz/losp/muerte/memref.lisp:1.27	Tue Aug 17 01:15:12 2004
+++ movitz/losp/muerte/memref.lisp	Thu Sep  2 11:38:46 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Tue Mar  6 21:25:49 2001
 ;;;;                
-;;;; $Id: memref.lisp,v 1.27 2004/08/16 23:15:12 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.28 2004/09/02 09:38:46 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -72,16 +72,16 @@
 		(:unsigned-byte8
 		 (cond
 		  ((and (eq 0 offset) (eq 0 index))
-		   `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+		   `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8))
 		      (:compile-form (:result-mode :eax) ,object)
 		      (:movzxb (:eax ,(offset-by 1)) :ecx)))
 		  ((eq 0 offset)
-		   `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+		   `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8))
 		      (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,index)
 		      (:movzxb (:eax :ecx ,(offset-by 1)) :ecx)))
 		  (t (let ((object-var (gensym "memref-object-")))
 		       `(let ((,object-var ,object))
-			  (with-inline-assembly (:returns :untagged-fixnum-ecx)
+			  (with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8))
 			    (:compile-two-forms (:ecx :ebx) ,offset ,index)
 			    (:load-lexical (:lexical-binding ,object-var) :eax)
 			    (:addl :ebx :ecx) ; index += offset
@@ -749,7 +749,7 @@
        (memref-int address offset index :unsigned-byte32 t))))))
 
 (define-compiler-macro (setf memref-int) (&whole form &environment env value address offset index type
-								   &optional physicalp)
+					  &optional physicalp)
   (if (or (not (movitz:movitz-constantp type env))
 	  (not (movitz:movitz-constantp physicalp env)))
       (progn
@@ -810,30 +810,45 @@
 	(:unsigned-byte16
 	 (cond
 	  ((eq 0 offset)
-	   `(with-inline-assembly (:returns :untagged-fixnum-eax)
-	      (:compile-form (:result-mode :push) ,address)
-	      (:compile-form (:result-mode :push) ,index)
-	      (:compile-form (:result-mode :eax) ,value)
-	      (:popl :ebx)		; index
-	      (:shrl ,movitz::+movitz-fixnum-shift+ :eax) ; scale value
-	      (:popl :ecx)		; address
-	      (:shll 1 :ebx)		; scale index
-	      (:addl :ebx :ecx)
-	      (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale address
-	      (,prefixes :movw :ax (:ecx))))
-	  (t `(with-inline-assembly (:returns :untagged-fixnum-eax)
-		(:compile-form (:result-mode :push) ,address)
-		(:compile-form (:result-mode :push) ,index)
-		(:compile-form (:result-mode :push) ,offset)
-		(:compile-form (:result-mode :eax) ,value)
-		(:popl :edx)		; offset
-		(:popl :ebx)		; index
-		(:popl :ecx)		; address
-		(:shrl ,movitz::+movitz-fixnum-shift+ :eax) ; scale value
-		(:leal (:ecx (:ebx 2)) :ecx)
-		(:addl :edx :ecx)	;
-		(:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+address
-		(,prefixes :movw :ax (:ecx))))))))))
+	   (let ((address-var (gensym "memref-int-address-"))
+		 (index-var (gensym "memref-index-var-"))
+		 (value-var (gensym "memref-value-var-")))
+	     `(let ((,value-var ,value)
+		    (,address-var ,address)
+		    (,index-var ,index))
+		(with-inline-assembly (:returns :untagged-fixnum-eax)
+		  (:load-lexical (:lexical-binding ,value-var) :eax) ; value
+		  (:load-lexical (:lexical-binding ,index-var) :ebx) ; index
+		  (:load-lexical (:lexical-binding ,address-var) :ecx) ; address
+		  (:shll 1 :ebx)	; scale index
+		  (:addl :ebx :ecx)
+		  (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) ; scale address
+		  (:std)
+		  (:shrl ,movitz:+movitz-fixnum-shift+ :eax) ; scale value
+		  (,prefixes :movw :ax (:ecx))
+		  (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax)
+		  (:cld)))))
+	  (t (let ((address-var (gensym "memref-int-address-"))
+		   (offset-var (gensym "memref-offset-var-"))
+		   (index-var (gensym "memref-index-var-"))
+		   (value-var (gensym "memref-value-var-")))
+	       `(let ((,value-var ,value)
+		      (,address-var ,address)
+		      (,offset-var ,offset)
+		      (,index-var ,index))
+		  (with-inline-assembly (:returns :untagged-fixnum-eax)
+		    (:load-lexical (:lexical-binding ,address-var) :ecx)
+		    (:load-lexical (:lexical-binding ,index-var) :ebx)
+		    (:load-lexical (:lexical-binding ,offset-var) :edx)
+		    (:load-lexical (:lexical-binding ,value-var) :eax)
+		    (:leal (:ecx (:ebx 2)) :ecx)
+		    (:addl :edx :ecx)	;
+		    (:shrl ,movitz::+movitz-fixnum-shift+ :eax) ; scale value
+		    (:std)
+		    (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+address
+		    (,prefixes :movw :ax (:ecx))
+		    (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax)
+		    (:cld)))))))))))
 
 (defun (setf memref-int) (value address offset index type &optional physicalp)
   (cond