[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-serv29031

Modified Files:
	memref.lisp 
Log Message:
Added :physicalp option for (memref :unsigned-byte32).

Date: Fri Apr 15 09:03:47 2005
Author: ffjeld

Index: movitz/losp/muerte/memref.lisp
diff -u movitz/losp/muerte/memref.lisp:1.44 movitz/losp/muerte/memref.lisp:1.45
--- movitz/losp/muerte/memref.lisp:1.44	Wed Mar  9 08:19:53 2005
+++ movitz/losp/muerte/memref.lisp	Fri Apr 15 09:03:47 2005
@@ -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.44 2005/03/09 07:19:53 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.45 2005/04/15 07:03:47 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -18,12 +18,14 @@
 
 (in-package muerte)
 
-(define-compiler-macro memref (&whole form object offset &key (index 0) (type :lisp)
-							      (localp nil) (endian :host)
+(define-compiler-macro memref (&whole form object offset
+			       &key (index 0) (type :lisp) (localp nil) (endian :host)
+				    (physicalp nil)
 			       &environment env)
   (if (or (not (movitz:movitz-constantp type env))
 	  (not (movitz:movitz-constantp localp env))
-	  (not (movitz:movitz-constantp endian env)))
+	  (not (movitz:movitz-constantp endian env))
+	  (not (movitz:movitz-constantp physicalp env)))
       form
     (labels ((sub-extract-constant-delta (form)
 	       "Try to extract at compile-time an integer offset from form."
@@ -69,7 +71,10 @@
 	    (warn "o: ~S, co: ~S, i: ~S, ci: ~S"
 		  offset constant-offset
 		  index constant-index)
-	    (let ((type (movitz:movitz-eval type env)))
+	    (let ((type (movitz:movitz-eval type env))
+		  (physicalp (movitz:movitz-eval physicalp env)))
+	      (when (and physicalp (not (eq type :unsigned-byte32)))
+		(warn "(memref physicalp) unsupported for type ~S." type))
 	      (case type
 		(:unsigned-byte8
 		 (cond
@@ -310,29 +315,32 @@
 			    (:movl (:eax :ecx ,(offset-by 4)) :ecx)
 			    (:andl 7 :ecx)))))))
 		(:unsigned-byte32
-		 (let ((endian (movitz:movitz-eval endian env)))
-		   (assert (member endian '(:host :little))))
-		 (assert (= 4 movitz::+movitz-fixnum-factor+))
-		 (cond
-		  ((and (eq 0 offset) (eq 0 index))
-		   `(with-inline-assembly (:returns :untagged-fixnum-ecx
-						    :type (unsigned-byte 32))
-		      (:compile-form (:result-mode :eax) ,object)
-		      (:movl (:eax ,(offset-by 4)) :ecx)))
-		  ((eq 0 offset)
-		   `(with-inline-assembly (:returns :untagged-fixnum-ecx
-						    :type (unsigned-byte 32))
-		      (:compile-two-forms (:eax :ecx) ,object ,index)
-		      (:movl (:eax :ecx ,(offset-by 4)) :ecx)))
-		  (t (let ((object-var (gensym "memref-object-")))
-		       `(let ((,object-var ,object))
-			  (with-inline-assembly (:returns :untagged-fixnum-ecx
-							  :type (unsigned-byte 32))
-			    (: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)))))))
+		 (let ((endian (movitz:movitz-eval endian env))
+		       (prefixes (if (not physicalp)
+				     ()
+				   movitz:*compiler-physical-segment-prefix*)))
+		   (assert (member endian '(:host :little)))
+		   (assert (= 4 movitz::+movitz-fixnum-factor+))
+		   (cond
+		    ((and (eq 0 offset) (eq 0 index))
+		     `(with-inline-assembly (:returns :untagged-fixnum-ecx
+						      :type (unsigned-byte 32))
+			(:compile-form (:result-mode :eax) ,object)
+			(,prefixes :movl (:eax ,(offset-by 4)) :ecx)))
+		    ((eq 0 offset)
+		     `(with-inline-assembly (:returns :untagged-fixnum-ecx
+						      :type (unsigned-byte 32))
+			(:compile-two-forms (:eax :ecx) ,object ,index)
+			(,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx)))
+		    (t (let ((object-var (gensym "memref-object-")))
+			 `(let ((,object-var ,object))
+			    (with-inline-assembly (:returns :untagged-fixnum-ecx
+							    :type (unsigned-byte 32))
+			      (:compile-two-forms (:ecx :ebx) ,offset ,index)
+			      (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
+			      (:load-lexical (:lexical-binding ,object-var) :eax)
+			      (:addl :ebx :ecx)
+			      (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx))))))))
 		(:lisp
 		 (let* ((localp (movitz:movitz-eval localp env))
 			(prefixes (if localp