[movitz-cvs] CVS movitz/losp/muerte
ffjeld
ffjeld at common-lisp.net
Sun Jan 13 22:27:10 UTC 2008
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv9220
Modified Files:
memref.lisp
Log Message:
Fix (setf memref-int :type :unsigned-byte32), which was quite buggy, as reported by mxb.
--- /project/movitz/cvsroot/movitz/losp/muerte/memref.lisp 2007/04/13 23:19:57 1.49
+++ /project/movitz/cvsroot/movitz/losp/muerte/memref.lisp 2008/01/13 22:27:10 1.50
@@ -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.49 2007/04/13 23:19:57 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.50 2008/01/13 22:27:10 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -998,109 +998,127 @@
(define-compiler-macro (setf memref-int)
(&whole form value address &key (offset 0) (index 0) (type :type) (physicalp t)
- &environment env)
+ &environment env)
(if (or (not (movitz:movitz-constantp type env))
(not (movitz:movitz-constantp physicalp env)))
(progn
(warn "setf memref-int form: ~S, ~S ~S" form type physicalp)
form)
- (let* ((physicalp (movitz::eval-form physicalp env))
- (prefixes (if (not physicalp)
- ()
- movitz:*compiler-physical-segment-prefix*)))
- (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 :eax)
- (:compile-form (:result-mode :push) ,address)
- (:compile-form (:result-mode :push) ,index)
- (:compile-form (:result-mode :push) ,offset)
- (:compile-form (:result-mode :eax) ,value)
- (:popl :edx) ; offset
- (:popl :ebx) ; index
- (:popl :ecx) ; address
- (:addl :edx :ecx)
- (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
- (,prefixes :movl :eax (:ecx :ebx))))
- (:unsigned-byte8
- (let ((address-var (gensym "memref-int-address-"))
- (index-var (gensym "memref-int-index-var-"))
- (offset-var (gensym "memref-int-offset-var-"))
- (value-var (gensym "memref-int-value-var-")))
- `(let ((,value-var ,value)
- (,address-var ,address)
- (,offset-var (+ ,index ,offset)))
- (with-inline-assembly (:returns :nothing)
- (:load-lexical (:lexical-binding ,address-var) :ecx)
- (:load-lexical (:lexical-binding ,offset-var) :edx)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- (:shll ,(- 8 movitz::+movitz-fixnum-shift+) :eax)
- (:addl :edx :ecx)
- (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
- (,prefixes :movb :ah (:ecx)))
- ,value-var)))
- (:unsigned-byte16
- (cond
- ((eq 0 offset)
+ (let* ((physicalp (movitz::eval-form physicalp env))
+ (prefixes (if (not physicalp)
+ ()
+ movitz:*compiler-physical-segment-prefix*)))
+ (ecase type
+ (:unsigned-byte32
+ (assert (= 4 movitz:+movitz-fixnum-factor+))
+ (cond
+ ((movitz:movitz-constantp offset env)
+ (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 ,movitz:+movitz-fixnum-zmask+
+ :cl)
+ (:jnz '(:sub-program () (:int 70)))
+ (:pushl :ecx) ; an untagged integer (zerop (mod x 4)) is still GC-safe.
+ (:compile-form (:result-mode :untagged-fixnum-ecx) ,value-var)
+ (:popl :eax)
+ (:movl :ecx (:eax ,offset))))))
+ (t (let ((offset-var (gensym "memref-int-offset-"))
+ (addr-var (gensym "memref-int-address-"))
+ (value-var (gensym "memref-int-value-")))
+ `(let ((,offset-var ,offset)
+ (,value-var ,value)
+ (,addr-var (+ ,address ,offset ,index)))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-form (:result-mode :untagged-fixnum-ecx) ,addr-var)
+ (:testb ,movitz:+movitz-fixnum-zmask+
+ :cl)
+ (:jnz '(:sub-program () (:int 70)))
+ (:pushl :ecx) ; an untagged integer (zerop (mod x 4)) is still GC-safe.
+ (:compile-form (:result-mode :untagged-fixnum-ecx) ,value-var)
+ (:popl :eax)
+ (:compile-form (:result-mode :edx) ,offset-var)
+ (:std)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :edx)
+ (:movl :ecx (:eax :edx))
+ (:movl :edi :edx) ; make EDX GC-safe
+ (:cld)))))))
+ (:lisp
+ (assert (= 4 movitz:+movitz-fixnum-factor+))
+ `(with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :push) ,address)
+ (:compile-form (:result-mode :push) ,index)
+ (:compile-form (:result-mode :push) ,offset)
+ (:compile-form (:result-mode :eax) ,value)
+ (:popl :edx) ; offset
+ (:popl :ebx) ; index
+ (:popl :ecx) ; address
+ (:addl :edx :ecx)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (,prefixes :movl :eax (:ecx :ebx))))
+ (:unsigned-byte8
(let ((address-var (gensym "memref-int-address-"))
- (index-var (gensym "memref-index-var-"))
- (value-var (gensym "memref-value-var-")))
+ (index-var (gensym "memref-int-index-var-"))
+ (offset-var (gensym "memref-int-offset-var-"))
+ (value-var (gensym "memref-int-value-var-")))
`(let ((,value-var ,value)
(,address-var ,address)
- (,index-var ,index))
- (with-inline-assembly (:returns :eax)
- (:load-lexical (:lexical-binding ,value-var) :eax) ; value
- (:load-lexical (:lexical-binding ,index-var) :ebx) ; index
- (:load-lexical (:lexical-binding ,address-var) :ecx) ; address
- (:shll 1 :ebx) ; scale index
- (:addl :ebx :ecx)
- (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) ; scale address
- (:std)
- (:shrl ,movitz:+movitz-fixnum-shift+ :eax) ; scale value
- (,prefixes :movw :ax (:ecx))
- (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax)
- (:cld)))))
- (t (let ((address-var (gensym "memref-int-address-"))
- (offset-var (gensym "memref-offset-var-"))
- (index-var (gensym "memref-index-var-"))
- (value-var (gensym "memref-value-var-")))
- `(let ((,value-var ,value)
- (,address-var ,address)
- (,offset-var ,offset)
- (,index-var ,index))
- (with-inline-assembly (:returns :eax)
- (:load-lexical (:lexical-binding ,address-var) :ecx)
- (:load-lexical (:lexical-binding ,index-var) :ebx)
- (:load-lexical (:lexical-binding ,offset-var) :edx)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- (:leal (:ecx (:ebx 2)) :ecx)
- (:addl :edx :ecx) ;
- (:shrl ,movitz::+movitz-fixnum-shift+ :eax) ; scale value
- (:std)
- (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+address
- (,prefixes :movw :ax (:ecx))
- (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax)
- (:cld)))))))))))
+ (,offset-var (+ ,index ,offset)))
+ (with-inline-assembly (:returns :nothing)
+ (:load-lexical (:lexical-binding ,address-var) :ecx)
+ (:load-lexical (:lexical-binding ,offset-var) :edx)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:shll ,(- 8 movitz::+movitz-fixnum-shift+) :eax)
+ (:addl :edx :ecx)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (,prefixes :movb :ah (:ecx)))
+ ,value-var)))
+ (:unsigned-byte16
+ (cond
+ ((eq 0 offset)
+ (let ((address-var (gensym "memref-int-address-"))
+ (index-var (gensym "memref-index-var-"))
+ (value-var (gensym "memref-value-var-")))
+ `(let ((,value-var ,value)
+ (,address-var ,address)
+ (,index-var ,index))
+ (with-inline-assembly (:returns :eax)
+ (:load-lexical (:lexical-binding ,value-var) :eax) ; value
+ (:load-lexical (:lexical-binding ,index-var) :ebx) ; index
+ (:load-lexical (:lexical-binding ,address-var) :ecx) ; address
+ (:shll 1 :ebx) ; scale index
+ (:addl :ebx :ecx)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) ; scale address
+ (:std)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :eax) ; scale value
+ (,prefixes :movw :ax (:ecx))
+ (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax)
+ (:cld)))))
+ (t (let ((address-var (gensym "memref-int-address-"))
+ (offset-var (gensym "memref-offset-var-"))
+ (index-var (gensym "memref-index-var-"))
+ (value-var (gensym "memref-value-var-")))
+ `(let ((,value-var ,value)
+ (,address-var ,address)
+ (,offset-var ,offset)
+ (,index-var ,index))
+ (with-inline-assembly (:returns :eax)
+ (:load-lexical (:lexical-binding ,address-var) :ecx)
+ (:load-lexical (:lexical-binding ,index-var) :ebx)
+ (:load-lexical (:lexical-binding ,offset-var) :edx)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:leal (:ecx (:ebx 2)) :ecx)
+ (:addl :edx :ecx) ;
+ (:shrl ,movitz::+movitz-fixnum-shift+ :eax) ; scale value
+ (:std)
+ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+address
+ (,prefixes :movw :ax (:ecx))
+ (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax)
+ (:cld)))))))))))
(defun (setf memref-int)
(value address &key (offset 0) (index 0) (type :unsigned-byte32) (physicalp t))
More information about the Movitz-cvs
mailing list