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@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)