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