[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Sat Jul 17 01:53:17 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv26944
Modified Files:
memref.lisp
Log Message:
Fixed some bugs wrt. argument evaluation order.
Date: Fri Jul 16 18:53:17 2004
Author: ffjeld
Index: movitz/losp/muerte/memref.lisp
diff -u movitz/losp/muerte/memref.lisp:1.17 movitz/losp/muerte/memref.lisp:1.18
--- movitz/losp/muerte/memref.lisp:1.17 Fri Jul 16 03:06:36 2004
+++ movitz/losp/muerte/memref.lisp Fri Jul 16 18:53:17 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.17 2004/07/16 10:06:36 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.18 2004/07/17 01:53:17 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -92,14 +92,23 @@
(:compile-form (:result-mode :eax) ,object)
(:movzxw (:eax ,(offset-by 2)) :ecx)))
((eq 0 offset)
- `(with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:compile-two-forms (:eax :ecx) ,object ,index)
- (:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
- (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)))
- (t (let ((object-var (gensym "memref-object-")))
- `(let ((,object-var ,object))
+ (let ((object-var (gensym "memref-object-"))
+ (index-var (gensym "memref-index-")))
+ `(let ((,object-var ,object)
+ (,index-var ,index))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx
+ :type (unsiged-byte 16))
+ (:compile-two-forms (:eax :ecx) ,object-var ,index-var)
+ (:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
+ (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)))))
+ (t (let ((object-var (gensym "memref-object-"))
+ (offset-var (gensym "memref-offset-"))
+ (index-var (gensym "memref-index-")))
+ `(let ((,object-var ,object)
+ (,offset-var ,offset)
+ (,index-var ,index))
(with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:compile-two-forms (:ecx :ebx) ,offset-var ,index-var)
(:leal (:ecx (:ebx 2)) :ecx)
(:load-lexical (:lexical-binding ,object-var) :eax)
(:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
@@ -378,40 +387,55 @@
(* 2 (movitz:movitz-eval index env)))))))
((and (movitz:movitz-constantp offset env)
(movitz:movitz-constantp value env))
- (let ((value (movitz:movitz-eval value env)))
+ (let ((value (movitz:movitz-eval value env))
+ (index-var (gensym "memref-index-"))
+ (object-var (gensym "memref-object-")))
(check-type value (unsigned-byte 16))
- `(progn
+ `(let ((,object-var ,object)
+ (,index-var ,index))
(with-inline-assembly (:returns :nothing)
- (:compile-two-forms (:ecx :ebx) ,index ,object)
+ (:compile-two-forms (:ecx :ebx) ,index-var ,object-var)
(:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
(:movw ,value (:ebx :ecx ,(movitz:movitz-eval offset env))))
,value)))
((movitz:movitz-constantp offset env)
- (let ((value-var (gensym "memref-value-")))
+ (let ((value-var (gensym "memref-value-"))
+ (index-var (gensym "memref-index-"))
+ (object-var (gensym "memref-object-")))
(if (<= 16 movitz:*compiler-allow-untagged-word-bits*)
- `(let ((,value-var ,value))
+ `(let ((,value-var ,value)
+ (,object-var ,object)
+ (,index-var ,index))
(with-inline-assembly (:returns :untagged-fixnum-eax)
- (:compile-two-forms (:ebx :ecx) ,object ,index)
+ (:compile-two-forms (:ebx :ecx) ,object-var ,index-var)
(:load-lexical (:lexical-binding ,value-var) :untagged-fixnum-eax)
(:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
(:movw :ax (:ebx :ecx ,(movitz:movitz-eval offset env)))))
- `(let ((,value-var ,value))
+ `(let ((,value-var ,value)
+ (,object-var ,object)
+ (,index-var ,index))
(with-inline-assembly (:returns :nothing)
- (:compile-two-forms (:ebx :ecx) ,object ,index)
+ (:compile-two-forms (:ebx :ecx) ,object-var ,index-var)
(:load-lexical (:lexical-binding ,value-var) :eax)
(:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
- (:shll ,(- 8 movitz:+movitz-fixnum-shift+) :eax)
- (:movb :ah (:ebx :ecx ,(movitz:movitz-eval offset env)))
- (:andl #xff0000 :eax)
- (:shrl 8 :eax)
- (:movb :ah (:ebx :ecx ,(1+ (movitz:movitz-eval offset env)))))
+ (:movl :edi :edx)
+ (:std)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
+ (:movw :ax (:ebx :ecx ,(movitz:movitz-eval offset env)))
+ (:movl :edi :eax)
+ (:cld))
,value-var))))
(t (let ((value-var (gensym "memref-value-"))
- (object-var (gensym "memref-object-")))
+ (object-var (gensym "memref-object-"))
+ (offset-var (gensym "memref-offset-"))
+ (index-var (gensym "memref-index-")))
(if (<= 16 movitz:*compiler-allow-untagged-word-bits*)
- `(let ((,value-var ,offset) (,object-var ,object))
+ `(let ((,value-var ,value)
+ (,object-var ,object)
+ (,offset-var ,offset)
+ (,index-var ,index))
(with-inline-assembly (:returns :untagged-fixnum-eax)
- (:compile-two-forms (:ebx :ecx) ,offset ,index)
+ (:compile-two-forms (:ebx :ecx) ,offset-var ,index-var)
(:load-lexical (:lexical-binding ,value-var) :eax)
(:andl ,(* movitz:+movitz-fixnum-factor+ #xffff) :eax)
(:leal (:ebx (:ecx 2)) :ecx)
@@ -419,9 +443,12 @@
(:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
(:load-lexical (:lexical-binding ,object-var) :ebx)
(:movw :ax (:ebx :ecx))))
- `(let ((,value-var ,value) (,object-var ,object))
+ `(let ((,value-var ,value)
+ (,object-var ,object)
+ (,offset-var ,offset)
+ (,index-var ,index))
(with-inline-assembly (:returns :nothing)
- (:compile-two-forms (:ebx :ecx) ,offset ,index)
+ (:compile-two-forms (:ebx :ecx) ,offset-var ,index-var)
(:load-lexical (:lexical-binding ,value-var) :eax)
(:leal (:ebx (:ecx 2)) :ecx)
(:shll ,(- 8 movitz:+movitz-fixnum-shift+) :eax)
More information about the Movitz-cvs
mailing list