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(a)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))))