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

Frode Vatvedt Fjeld ffjeld at common-lisp.net
Wed Mar 31 18:33:52 UTC 2004


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

Modified Files:
	memref.lisp 
Log Message:
Smarted up memref considerably.

Date: Wed Mar 31 13:33:52 2004
Author: ffjeld

Index: movitz/losp/muerte/memref.lisp
diff -u movitz/losp/muerte/memref.lisp:1.6 movitz/losp/muerte/memref.lisp:1.7
--- movitz/losp/muerte/memref.lisp:1.6	Wed Mar 31 11:49:23 2004
+++ movitz/losp/muerte/memref.lisp	Wed Mar 31 13:33:52 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.6 2004/03/31 16:49:23 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.7 2004/03/31 18:33:52 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -30,13 +30,13 @@
 (define-compiler-macro memref (&whole form object offset index type &environment env)
 ;;;  (assert (typep offset '(integer 0 0)) (offset)
 ;;;    (error "memref offset not supported."))
-  (if (not (movitz:movitz-constantp type))
+  (if (not (movitz:movitz-constantp type env))
       form
     (labels ((extract-constant-delta (form)
 	     "Try to extract at compile-time an integer offset from form."
 	     (cond
 	      ((movitz:movitz-constantp form env)
-	       (let ((x (movitz::eval-form form env)))
+	       (let ((x (movitz:movitz-eval form env)))
 		 (check-type x integer)
 		 (values x 0)))
 	      ((not (consp form))
@@ -49,7 +49,7 @@
 			(2 (values 0 (second form)))
 			(t (loop with x = 0 and f = nil for sub-form in (cdr form)
 			       as sub-value = (when (movitz:movitz-constantp sub-form env)
-						(movitz::eval-form sub-form env))
+						(movitz:movitz-eval sub-form env))
 			       do (if (integerp sub-value)
 				      (incf x sub-value)
 				    (push sub-form f))
@@ -66,37 +66,46 @@
 	    (warn "o: ~S, co: ~S, i: ~S, ci: ~S"
 		  offset constant-offset
 		  index constant-index)
-	    (let ((type (movitz::eval-form type env)))
+	    (let ((type (movitz:movitz-eval type env)))
 	      (case type
 		(:unsigned-byte8
-		 `(with-inline-assembly (:returns :untagged-fixnum-eax)
-		    (:compile-form (:result-mode :push) ,object)
-		    (:compile-two-forms (:ecx :ebx) ,offset ,index)
-		    (:popl :eax)	; object
-		    (:addl :ecx :ebx)	; index += offset
-		    (:sarl #.movitz::+movitz-fixnum-shift+ :ebx)
-		    (:movzxb (:eax :ebx ,(offset-by 1)) :eax)))
+		 (cond
+		  ((and (eq 0 offset) (eq 0 index))
+		   `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+		      (:compile-form (:result-mode :eax) ,object)
+		      (:movzxb (:eax ,(offset-by 1)) :ecx)))
+		  ((eq 0 offset)
+		   `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+		      (:compile-two-forms (:eax :ecx) ,object ,index)
+		      (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+		      (: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)
+			    (:compile-two-forms (:ecx :ebx) ,offset ,index)
+			    (:load-lexical (:lexical-binding ,object-var) :eax)
+			    (:addl :ebx :ecx) ; index += offset
+			    (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
+			    (:movzxb (:eax :ecx ,(offset-by 1)) :ecx)))))))
 		(:unsigned-byte16
-		 `(with-inline-assembly (:returns :untagged-fixnum-ecx)
-		    (:compile-form (:result-mode :push) ,object)
-		    (:compile-two-forms (:eax :ebx) ,offset ,index)
-		    (:sarl #.(cl:1- movitz::+movitz-fixnum-shift+) :ebx)
-		    (:sarl #.movitz::+movitz-fixnum-shift+ :eax)
-		    (:addl :eax :ebx)
-		    (:popl :eax)	; object
-		    (:movzxw (:eax :ebx ,(offset-by 2)) :ecx)))
-		(:unsigned-byte32
-		 (assert (= 2 movitz::+movitz-fixnum-shift+))
-		 (let ((overflow (gensym "overflow-")))
+		 (cond
+		  ((and (eq 0 offset) (eq 0 index))
 		   `(with-inline-assembly (:returns :untagged-fixnum-ecx)
-		      (:compile-form (:result-mode :push) ,object)
-		      (:compile-two-forms (:ecx :ebx) ,offset ,index)
-		      (:sarl #.movitz::+movitz-fixnum-shift+ :ecx)
-		      (:addl :ebx :ecx)
-		      (:popl :eax)	; object
-		      (:movl (:eax :ecx ,(offset-by 4)) :ecx)
-		      (:cmpl ,movitz::+movitz-most-positive-fixnum+ :ecx)
-		      (:jg '(:sub-program (,overflow) (:int 4))))))
+		      (:compile-form (:result-mode :eax) ,object)
+		      (:movzxw (:eax ,(offset-by 2)) :ecx)))
+		  ((eq 0 offset)
+		   `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+		      (:compile-two-forms (:eax :ecx) ,object ,index)
+		      (:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
+		      (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)))
+		  (t (let ((object-var (gensym "memref-object-")))
+		       `(let ((,object-var ,object))
+			  (with-inline-assembly (:returns :untagged-fixnum-ecx)
+			    (:compile-two-forms (:ecx :ebx) ,offset ,index)
+			    (:leal (:ecx (:ebx 2)) :ecx)
+			    (:load-lexical (:lexical-binding ,object-var) :eax)
+			    (:sarl #.movitz::+movitz-fixnum-shift+ :ecx)
+			    (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)))))))
 		(:unsigned-byte29+3
 		 ;; Two values: the 29 upper bits as unsigned integer,
 		 ;; and secondly the lower 3 bits as unsigned.
@@ -133,7 +142,7 @@
 		    (:movl 2 :ecx)
 		    (:stc)))
 		(:character
-		 (when (eq 0 index) (warn "zero char index!"))
+		 (when (eq 0 index) (warn "memref zero char index!"))
 		 (cond
 		  ((eq 0 offset)
 		   `(with-inline-assembly (:returns :eax)
@@ -142,15 +151,41 @@
 		      (:movb #.(movitz:tag :character) :al)
 		      (:sarl #.movitz::+movitz-fixnum-shift+ :ebx) ; scale index
 		      (:movb (:ecx :ebx ,(offset-by 1)) :ah)))
-		  (t `(with-inline-assembly (:returns :eax)
-			(:compile-form (:result-mode :push) ,object)
-			(:compile-two-forms (:ecx :ebx) ,offset ,index)
-			(:addl :ecx :ebx)
-			(:xorl :eax :eax)
-			(:movb #.(movitz:tag :character) :al)
-			(:popl :ecx)	; pop object
-			(:sarl #.movitz::+movitz-fixnum-shift+ :ebx) ; scale offset+index
-			(:movb (:ebx :ecx ,(offset-by 1)) :ah)))))
+		  (t (let ((object-var (gensym "memref-object-")))
+		       `(let ((,object-var ,object))
+			  (with-inline-assembly (:returns :eax)
+			    (:compile-two-forms (:ecx :ebx) ,offset ,index)
+			    (:addl :ebx :ecx)
+			    (:xorl :eax :eax)
+			    (:movb #.(movitz:tag :character) :al)
+			    (:load-lexical (:lexical-binding ,object-var) :ebx)
+			    (:sarl #.movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+index
+			    (:movb (:ebx :ecx ,(offset-by 1)) :ah)))))))
+		(:unsigned-byte32
+		 (assert (= 4 movitz::+movitz-fixnum-factor+))
+		 (cond
+		  ((and (eq 0 offset) (eq 0 index))
+		   `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+		      (:compile-form (:result-mode :eax) ,object)
+		      (:movl (:eax ,(offset-by 4)) :ecx)
+		      (:cmpl ,movitz::+movitz-most-positive-fixnum+ :ecx)
+		      (:jg '(:sub-program () (:int 4)))))
+		  ((eq 0 offset)
+		   `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+		      (:compile-two-forms (:eax :ecx) ,object ,index)
+		      (:movl (:eax :ecx ,(offset-by 4)) :ecx)
+		      (:cmpl ,movitz::+movitz-most-positive-fixnum+ :ecx)
+		      (:jg '(:sub-program () (:int 4)))))
+		  (t (let ((object-var (gensym "memref-object-")))
+		       `(let ((,object-var ,object))
+			  (with-inline-assembly (:returns :untagged-fixnum-ecx)
+			    (:compile-two-forms (:ecx :ebx) ,offset ,index)
+			    (:sarl #.movitz::+movitz-fixnum-shift+ :ecx)
+			    (:load-lexical (:lexical-binding ,object-var) :eax)
+			    (:addl :ebx :ecx)
+			    (:movl (:eax :ecx ,(offset-by 4)) :ecx)
+			    (:cmpl ,movitz::+movitz-most-positive-fixnum+ :ecx)
+			    (:jg '(:sub-program () (:int 4)))))))))
 		(:lisp
 		 (cond
 		  ((and (eq 0 index) (eq 0 offset))
@@ -163,14 +198,17 @@
 		      ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
 			  `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx))
 		      (:movl (:eax :ecx ,(offset-by 4)) :eax)))
-		  (t `(with-inline-assembly (:returns :eax)
-			(:compile-form (:result-mode :push) ,object)
-			(:compile-two-forms (:untagged-fixnum-eax :ecx) ,offset ,index)
-			,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
-			    `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx))
-			(:addl :ecx :eax)
-			(:popl :ebx)	; pop object
-			(:movl (:eax :ebx ,(offset-by 4)) :eax)))))
+		  (t (assert (not (movitz:movitz-constantp offset env)))
+		     (assert (not (movitz:movitz-constantp index env)))
+		     (let ((object-var (gensym "memref-object-")))
+		       (assert (= 4 movitz:+movitz-fixnum-factor+))
+		       `(let ((,object-var ,object))
+			  (with-inline-assembly (:returns :eax)
+			    (:compile-two-forms (:ecx :ebx) ,offset ,index)
+			    (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
+			    (:load-lexical (:lexical-binding ,object-var) :eax)
+			    (:addl :ebx :ecx)
+			    (:movl (:eax :ecx ,(offset-by 4)) :eax)))))))
 		(t (error "Unknown memref type: ~S" (movitz::eval-form type nil nil))
 		   form)))))))))
 





More information about the Movitz-cvs mailing list