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

Modified Files:
	memref.lisp 
Log Message:
Implemented (setf memref-int) for type :unsigned-byte32.

Date: Fri Aug  6 07:46:45 2004
Author: ffjeld

Index: movitz/losp/muerte/memref.lisp
diff -u movitz/losp/muerte/memref.lisp:1.22 movitz/losp/muerte/memref.lisp:1.23
--- movitz/losp/muerte/memref.lisp:1.22	Fri Jul 23 18:28:27 2004
+++ movitz/losp/muerte/memref.lisp	Fri Aug  6 07:46:45 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.22 2004/07/24 01:28:27 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.23 2004/08/06 14:46:45 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -722,6 +722,26 @@
     (let* ((physicalp (movitz::eval-form physicalp env))
 	   (prefixes (if physicalp '(:gs-override) ())))
       (ecase type
+	(:unsigned-byte32
+	 (assert (= 4 movitz:+movitz-fixnum-factor+))
+	 (if (not (movitz:movitz-constantp offset env))
+	     form
+	   (let ((offset (movitz:movitz-eval offset env))
+		 (addr-var (gensym "memref-int-address-"))
+		 (value-var (gensym "memref-int-value-")))
+	     `(let ((,value-var ,value)
+		    (,addr-var (+ ,address ,index)))
+		(with-inline-assembly (:returns :untagged-fixnum-ecx)
+		  (:compile-form (:result-mode :untagged-fixnum-ecx) ,addr-var)
+		  (:testb ,(logior movitz:+movitz-fixnum-zmask+
+				   (* 3 movitz:+movitz-fixnum-factor+))
+			  :cl)
+		  (:jnz '(:sub-program () (:int 70)))
+		  (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) ; a fixnum (zerop (mod x 4)) shifted
+		  (:pushl :ecx)		; ..twice left is still a fixnum!
+		  (:compile-form (:result-mode :untagged-fixnum-ecx) ,value-var)
+		  (:popl :eax)
+		  (:movl :ecx (:eax ,offset)))))))
 	(:lisp
 	 (assert (= 4 movitz:+movitz-fixnum-factor+))
 	 `(with-inline-assembly (:returns :untagged-fixnum-eax)