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

Modified Files:
	memref.lisp 
Log Message:
Added a proper (setf memref .. :unsigned-byte32).

Date: Sun Mar 28 11:19:20 2004
Author: ffjeld

Index: movitz/losp/muerte/memref.lisp
diff -u movitz/losp/muerte/memref.lisp:1.3 movitz/losp/muerte/memref.lisp:1.4
--- movitz/losp/muerte/memref.lisp:1.3	Fri Mar 26 08:58:27 2004
+++ movitz/losp/muerte/memref.lisp	Sun Mar 28 11:19:20 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.3 2004/03/26 13:58:27 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.4 2004/03/28 16:19:20 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -205,6 +205,18 @@
 	  (:sarl #.movitz::+movitz-fixnum-shift+ :ebx)
 	  (:popl :ecx)			; object
 	  (:movb :ah (:ebx :ecx))))
+      (:unsigned-byte32
+       (assert (= 4 movitz::+movitz-fixnum-factor+))
+       `(with-inline-assembly (:returns :untagged-fixnum-eax)
+	  (:compile-form (:result-mode :push) ,object)
+	  (:compile-form (:result-mode :push) ,offset)
+	  (:compile-two-forms (:ebx :eax) ,index ,value)
+	  (:popl :ecx)			; offset
+	  (:shrl #.movitz::+movitz-fixnum-shift+ :eax)
+	  (:sarl #.movitz::+movitz-fixnum-shift+ :ecx)
+	  (:addl :ebx :ecx)		; index += offset
+	  (:popl :ebx)			; object
+	  (:movl :eax (:ebx :ecx))))
       (:unsigned-byte16
        `(with-inline-assembly (:returns :untagged-fixnum-eax)
 	  (:compile-form (:result-mode :push) ,object)
@@ -214,8 +226,8 @@
 	  (:popl :ecx)			; offset
 	  (:shrl #.movitz::+movitz-fixnum-shift+ :eax)
 	  (:sarl #.movitz::+movitz-fixnum-shift+ :ecx)
-	  (:addl :ecx :ebx)		; index += offset
-	  (:popl :ecx)			; object
+	  (:addl :ebx :ecx)		; index += offset
+	  (:popl :ebx)			; object
 	  (:movw :ax (:ebx :ecx))))
       (:unsigned-byte8
        `(with-inline-assembly (:returns :untagged-fixnum-eax)
@@ -252,9 +264,7 @@
     (:unsigned-byte16
      (setf (memref object offset index :unsigned-byte16) value))
     (:unsigned-byte32
-     (setf (memref object offset (* index 2) :unsigned-byte16) (ldb (byte 16 0) value)
-	   (memref object offset (+ 1 (* index 2)) :unsigned-byte16) (ldb (byte 14 16) value))
-     value)
+     (setf (memref object offset index :unsigned-byte32) value))
     (:lisp
      (setf (memref object offset index :lisp) value))))