[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Sat May 21 22:37:33 UTC 2005
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv4874
Modified Files:
memref.lisp
Log Message:
*** empty log message ***
Date: Sun May 22 00:37:32 2005
Author: ffjeld
Index: movitz/losp/muerte/memref.lisp
diff -u movitz/losp/muerte/memref.lisp:1.45 movitz/losp/muerte/memref.lisp:1.46
--- movitz/losp/muerte/memref.lisp:1.45 Fri Apr 15 09:03:47 2005
+++ movitz/losp/muerte/memref.lisp Sun May 22 00:37:32 2005
@@ -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.45 2005/04/15 07:03:47 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.46 2005/05/21 22:37:32 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -18,15 +18,9 @@
(in-package muerte)
-(define-compiler-macro memref (&whole form object offset
- &key (index 0) (type :lisp) (localp nil) (endian :host)
- (physicalp nil)
- &environment env)
- (if (or (not (movitz:movitz-constantp type env))
- (not (movitz:movitz-constantp localp env))
- (not (movitz:movitz-constantp endian env))
- (not (movitz:movitz-constantp physicalp env)))
- form
+(eval-when (:compile-toplevel)
+ (defun extract-constant-delta (form env)
+ "Try to extract at compile-time an integer offset from form, repeatedly."
(labels ((sub-extract-constant-delta (form)
"Try to extract at compile-time an integer offset from form."
(cond
@@ -49,369 +43,329 @@
(incf x sub-value)
(push sub-form f))
finally (return (values x (cons '+ (nreverse f))))))))
- (t #+ignore (warn "extract from: ~S" form)
- (values 0 form))))))
- (extract-constant-delta (form)
- "Try to extract at compile-time an integer offset from form, repeatedly."
- (multiple-value-bind (constant-term variable-term)
- (sub-extract-constant-delta form)
- (if (= 0 constant-term)
- (values 0 variable-term)
- (multiple-value-bind (sub-constant-term sub-variable-term)
- (extract-constant-delta variable-term)
- (values (+ constant-term sub-constant-term)
- sub-variable-term))))))
- (multiple-value-bind (constant-index index)
- (extract-constant-delta index)
- (multiple-value-bind (constant-offset offset)
- (extract-constant-delta offset)
- (flet ((offset-by (element-size)
- (+ constant-offset (* constant-index element-size))))
- #+ignore
- (warn "o: ~S, co: ~S, i: ~S, ci: ~S"
- offset constant-offset
- index constant-index)
- (let ((type (movitz:movitz-eval type env))
- (physicalp (movitz:movitz-eval physicalp env)))
- (when (and physicalp (not (eq type :unsigned-byte32)))
- (warn "(memref physicalp) unsupported for type ~S." type))
- (case type
- (:unsigned-byte8
+ (t (values 0 form)))))))
+ (multiple-value-bind (constant-term variable-term)
+ (sub-extract-constant-delta form)
+ (if (= 0 constant-term)
+ (values 0 variable-term)
+ (multiple-value-bind (sub-constant-term sub-variable-term)
+ (extract-constant-delta variable-term env)
+ (values (+ constant-term sub-constant-term)
+ sub-variable-term)))))))
+
+(define-compiler-macro memref (&whole form object offset
+ &key (index 0) (type :lisp) (localp nil) (endian :host)
+ (physicalp nil)
+ &environment env)
+ (if (or (not (movitz:movitz-constantp type env))
+ (not (movitz:movitz-constantp localp env))
+ (not (movitz:movitz-constantp endian env))
+ (not (movitz:movitz-constantp physicalp env)))
+ form
+ (multiple-value-bind (constant-index index)
+ (extract-constant-delta index env)
+ (multiple-value-bind (constant-offset offset)
+ (extract-constant-delta offset env)
+ (flet ((offset-by (element-size)
+ (+ constant-offset (* constant-index element-size))))
+ #+ignore
+ (warn "o: ~S, co: ~S, i: ~S, ci: ~S"
+ offset constant-offset
+ index constant-index)
+ (let ((type (movitz:movitz-eval type env))
+ (physicalp (movitz:movitz-eval physicalp env)))
+ (when (and physicalp (not (eq type :unsigned-byte32)))
+ (warn "(memref physicalp) unsupported for type ~S." type))
+ (case type
+ (:unsigned-byte8
+ (cond
+ ((and (eql 0 offset) (eql 0 index))
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8))
+ (:compile-form (:result-mode :eax) ,object)
+ (:movzxb (:eax ,(offset-by 1)) :ecx)))
+ ((eql 0 index)
+ (let ((object-var (gensym "memref-object-"))
+ (offset-var (gensym "memref-offset-")))
+ `(let ((,object-var ,object)
+ (,offset-var ,offset))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx
+ :type (unsigned-byte 8))
+ (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object-var ,offset-var)
+ ;; (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:movzxb (:eax :ecx ,(offset-by 1)) :ecx)
+ ))))
+ ((eql 0 offset)
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8))
+ (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,index)
+ (:movzxb (:eax :ecx ,(offset-by 1)) :ecx)))
+ (t (let ((object-var (gensym "memref-object-")))
+ `(let ((,object-var ,object))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8))
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:load-lexical (:lexical-binding ,object-var) :eax)
+ (:addl :ebx :ecx) ; index += offset
+ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:movzxb (:eax :ecx ,(offset-by 1)) :ecx)))))))
+ (:unsigned-byte16
+ (let* ((endian (ecase (movitz:movitz-eval endian env)
+ ((:host :little) :little)
+ (:big :big)))
+ (endian-fix-ecx (ecase endian
+ (:little nil)
+ (:big `((:xchgb :cl :ch))))))
(cond
((and (eql 0 offset) (eql 0 index))
- `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8))
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx
+ :type (unsigned-byte 16))
(:compile-form (:result-mode :eax) ,object)
- (:movzxb (:eax ,(offset-by 1)) :ecx)))
+ (:movzxw (:eax ,(offset-by 2)) :ecx)
+ , at endian-fix-ecx))
((eql 0 index)
(let ((object-var (gensym "memref-object-"))
(offset-var (gensym "memref-offset-")))
`(let ((,object-var ,object)
(,offset-var ,offset))
(with-inline-assembly (:returns :untagged-fixnum-ecx
- :type (unsigned-byte 8))
- (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object-var ,offset-var)
- ;; (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
- (:movzxb (:eax :ecx ,(offset-by 1)) :ecx)
- ))))
+ :type (unsigned-byte 16))
+ (:compile-two-forms (:eax :ecx) ,object-var ,offset-var)
+ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)
+ , at endian-fix-ecx))))
((eql 0 offset)
- `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8))
- (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,index)
- (:movzxb (:eax :ecx ,(offset-by 1)) :ecx)))
- (t (let ((object-var (gensym "memref-object-")))
- `(let ((,object-var ,object))
- (with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 8))
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
- (:load-lexical (:lexical-binding ,object-var) :eax)
- (:addl :ebx :ecx) ; index += offset
- (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
- (:movzxb (:eax :ecx ,(offset-by 1)) :ecx)))))))
- (:unsigned-byte16
- (let* ((endian (ecase (movitz:movitz-eval endian env)
- ((:host :little) :little)
- (:big :big)))
- (endian-fix-ecx (ecase endian
- (:little nil)
- (:big `((:xchgb :cl :ch))))))
- (cond
- ((and (eql 0 offset) (eql 0 index))
- `(with-inline-assembly (:returns :untagged-fixnum-ecx
- :type (unsigned-byte 16))
- (:compile-form (:result-mode :eax) ,object)
- (:movzxw (:eax ,(offset-by 2)) :ecx)
- , at endian-fix-ecx))
- ((eql 0 index)
- (let ((object-var (gensym "memref-object-"))
- (offset-var (gensym "memref-offset-")))
- `(let ((,object-var ,object)
- (,offset-var ,offset))
- (with-inline-assembly (:returns :untagged-fixnum-ecx
- :type (unsigned-byte 16))
- (:compile-two-forms (:eax :ecx) ,object-var ,offset-var)
- (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
- (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)
- , at endian-fix-ecx))))
- ((eql 0 offset)
- (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 (unsigned-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)
- , at endian-fix-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
- :type (unsigned-byte 16))
- (: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)
- (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)
- , at endian-fix-ecx)))))))
- (:unsigned-byte14
- (cond
- ((and (eq 0 offset) (eq 0 index))
- `(with-inline-assembly (:returns :ecx :type (unsigned-byte 14))
- (:compile-form (:result-mode :eax) ,object)
- (:movzxw (:eax ,(offset-by 2)) :ecx)
- (:testb ,movitz:+movitz-fixnum-zmask+ :cl)
- (:jnz '(:sub-program () (:int 63)))))
- ((eq 0 offset)
(let ((object-var (gensym "memref-object-"))
(index-var (gensym "memref-index-")))
`(let ((,object-var ,object)
(,index-var ,index))
- (with-inline-assembly (:returns :ecx)
+ (with-inline-assembly (:returns :untagged-fixnum-ecx
+ :type (unsigned-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)
- (:testb ,movitz:+movitz-fixnum-zmask+ :cl)
- (:jnz '(:sub-program () (:int 63)))))))
+ , at endian-fix-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 :ecx)
+ (with-inline-assembly (:returns :untagged-fixnum-ecx
+ :type (unsigned-byte 16))
(: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)
(:movzxw (:eax :ecx ,(offset-by 2)) :ecx)
- (:testb ,movitz:+movitz-fixnum-shift+ :cl)
- (:jnz '(:sub-program () (:int 63)))))))))
- (:unsigned-byte29+3
- ;; Two values: the 29 upper bits as unsigned integer,
- ;; and secondly the lower 3 bits as unsigned.
- (assert (= 2 movitz::+movitz-fixnum-shift+))
- `(with-inline-assembly (:returns :multiple-values)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
- (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
- (:addl :ebx :ecx)
- (:popl :eax) ; object
- (:movl (:eax :ecx ,(offset-by 4)) :ecx)
- (:leal ((:ecx 4)) :ebx)
- (:shrl 1 :ecx)
- (:andl #b11100 :ebx)
- (:andl -4 :ecx)
- (:movl :ecx :eax)
- (:movl 2 :ecx)
- (:stc)))
- (:signed-byte30+2
- ;; Two values: the 30 upper bits as signed integer,
- ;; and secondly the lower 2 bits as unsigned.
- (assert (= 2 movitz::+movitz-fixnum-shift+))
- (let ((fix-ecx `((:leal ((:ecx 4)) :ebx)
- (:andl -4 :ecx)
- (:andl #b1100 :ebx)
- (:movl :ecx :eax)
- (:movl 2 :ecx)
- (:stc))))
- (cond
- ((and (eq 0 offset) (eq 0 index))
- `(with-inline-assembly (:returns :multiple-values)
- (:compile-form (:result-mode :eax) ,object)
- (:movl (:eax ,(offset-by 4)) :ecx)
- , at fix-ecx))
- ((eq 0 offset)
- `(with-inline-assembly (:returns :multiple-values)
- (:compile-two-forms (:eax :ecx) ,object ,index)
- (:movl (:eax :ecx ,(offset-by 4)) :ecx)
- , at fix-ecx))
- (t (let ((object-var (gensym "memref-object-")))
- `(let ((,object-var ,object))
- (with-inline-assembly (:returns :multiple-values)
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
- (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
- (:load-lexical (:lexical-binding ,object-var) :eax)
- (:addl :ebx :ecx)
- (:movl (:eax :ecx ,(offset-by 4)) :ecx)
- , at fix-ecx))))))
- #+ignore
- `(with-inline-assembly (:returns :multiple-values)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
- (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
- (:addl :ebx :ecx)
- (:popl :eax) ; object
- (:movl (:eax :ecx ,(offset-by 4)) :ecx)
- (:leal ((:ecx 4)) :ebx)
- (:andl #b1100 :ebx)
- (:andl -4 :ecx)
- (:movl :ecx :eax)
- (:movl 2 :ecx)
- (:stc)))
- (:character
- (when (eq 0 index) (warn "memref zero char index!"))
- (cond
- ((eq 0 offset)
- `(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:ebx :ecx) ,object ,index)
- (:xorl :eax :eax)
- (:movb ,(movitz:tag :character) :al)
- (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale index
- (:movb (:ebx :ecx ,(offset-by 1)) :ah)))
- (t (let ((object-var (gensym "memref-object-")))
- `(let ((,object-var ,object))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
- (:addl :ebx :ecx)
- (:xorl :eax :eax)
- (:movb ,(movitz:tag :character) :al)
- (:load-lexical (:lexical-binding ,object-var) :ebx)
- (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+index
- (:movb (:ebx :ecx ,(offset-by 1)) :ah)))))))
- (:location
- (assert (= 4 movitz::+movitz-fixnum-factor+))
+ , at endian-fix-ecx)))))))
+ (:unsigned-byte14
+ (cond
+ ((and (eq 0 offset) (eq 0 index))
+ `(with-inline-assembly (:returns :ecx :type (unsigned-byte 14))
+ (:compile-form (:result-mode :eax) ,object)
+ (:movzxw (:eax ,(offset-by 2)) :ecx)
+ (:testb ,movitz:+movitz-fixnum-zmask+ :cl)
+ (:jnz '(:sub-program () (:int 63)))))
+ ((eq 0 offset)
+ (let ((object-var (gensym "memref-object-"))
+ (index-var (gensym "memref-index-")))
+ `(let ((,object-var ,object)
+ (,index-var ,index))
+ (with-inline-assembly (:returns :ecx)
+ (:compile-two-forms (:eax :ecx) ,object-var ,index-var)
+ (:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
+ (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)
+ (:testb ,movitz:+movitz-fixnum-zmask+ :cl)
+ (:jnz '(:sub-program () (:int 63)))))))
+ (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 :ecx)
+ (: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)
+ (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)
+ (:testb ,movitz:+movitz-fixnum-shift+ :cl)
+ (:jnz '(:sub-program () (:int 63)))))))))
+ (:unsigned-byte29+3
+ ;; Two values: the 29 upper bits as unsigned integer,
+ ;; and secondly the lower 3 bits as unsigned.
+ (assert (= 2 movitz::+movitz-fixnum-shift+))
+ `(with-inline-assembly (:returns :multiple-values)
+ (:compile-form (:result-mode :push) ,object)
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:addl :ebx :ecx)
+ (:popl :eax) ; object
+ (:movl (:eax :ecx ,(offset-by 4)) :ecx)
+ (:leal ((:ecx 4)) :ebx)
+ (:shrl 1 :ecx)
+ (:andl #b11100 :ebx)
+ (:andl -4 :ecx)
+ (:movl :ecx :eax)
+ (:movl 2 :ecx)
+ (:stc)))
+ (:signed-byte30+2
+ ;; Two values: the 30 upper bits as signed integer,
+ ;; and secondly the lower 2 bits as unsigned.
+ (assert (= 2 movitz::+movitz-fixnum-shift+))
+ (let ((fix-ecx `((:leal ((:ecx 4)) :ebx)
+ (:andl -4 :ecx)
+ (:andl #b1100 :ebx)
+ (:movl :ecx :eax)
+ (:movl 2 :ecx)
+ (:stc))))
(cond
((and (eq 0 offset) (eq 0 index))
- `(with-inline-assembly (:returns :ecx :type (signed-byte 30))
+ `(with-inline-assembly (:returns :multiple-values)
(:compile-form (:result-mode :eax) ,object)
(:movl (:eax ,(offset-by 4)) :ecx)
- (:andl -4 :ecx)))
+ , at fix-ecx))
((eq 0 offset)
- `(with-inline-assembly (:returns :ecx :type (signed-byte 30))
+ `(with-inline-assembly (:returns :multiple-values)
(:compile-two-forms (:eax :ecx) ,object ,index)
(:movl (:eax :ecx ,(offset-by 4)) :ecx)
- (:andl -4 :ecx)))
+ , at fix-ecx))
(t (let ((object-var (gensym "memref-object-")))
`(let ((,object-var ,object))
- (with-inline-assembly (:returns :ecx :type (signed-byte 30))
+ (with-inline-assembly (:returns :multiple-values)
(:compile-two-forms (:ecx :ebx) ,offset ,index)
(:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
(:load-lexical (:lexical-binding ,object-var) :eax)
(:addl :ebx :ecx)
(:movl (:eax :ecx ,(offset-by 4)) :ecx)
- (:andl -4 :ecx)))))))
- (:tag
+ , at fix-ecx))))))
+ #+ignore
+ `(with-inline-assembly (:returns :multiple-values)
+ (:compile-form (:result-mode :push) ,object)
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:addl :ebx :ecx)
+ (:popl :eax) ; object
+ (:movl (:eax :ecx ,(offset-by 4)) :ecx)
+ (:leal ((:ecx 4)) :ebx)
+ (:andl #b1100 :ebx)
+ (:andl -4 :ecx)
+ (:movl :ecx :eax)
+ (:movl 2 :ecx)
+ (:stc)))
+ (:character
+ (when (eq 0 index) (warn "memref zero char index!"))
+ (cond
+ ((eq 0 offset)
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ebx :ecx) ,object ,index)
+ (:xorl :eax :eax)
+ (:movb ,(movitz:tag :character) :al)
+ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale index
+ (:movb (:ebx :ecx ,(offset-by 1)) :ah)))
+ (t (let ((object-var (gensym "memref-object-")))
+ `(let ((,object-var ,object))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:addl :ebx :ecx)
+ (:xorl :eax :eax)
+ (:movb ,(movitz:tag :character) :al)
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+index
+ (:movb (:ebx :ecx ,(offset-by 1)) :ah)))))))
+ (:location
+ (assert (= 4 movitz::+movitz-fixnum-factor+))
+ (cond
+ ((and (eq 0 offset) (eq 0 index))
+ `(with-inline-assembly (:returns :ecx :type (signed-byte 30))
+ (:compile-form (:result-mode :eax) ,object)
+ (:movl (:eax ,(offset-by 4)) :ecx)
+ (:andl -4 :ecx)))
+ ((eq 0 offset)
+ `(with-inline-assembly (:returns :ecx :type (signed-byte 30))
+ (:compile-two-forms (:eax :ecx) ,object ,index)
+ (:movl (:eax :ecx ,(offset-by 4)) :ecx)
+ (:andl -4 :ecx)))
+ (t (let ((object-var (gensym "memref-object-")))
+ `(let ((,object-var ,object))
+ (with-inline-assembly (:returns :ecx :type (signed-byte 30))
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :eax)
+ (:addl :ebx :ecx)
+ (:movl (:eax :ecx ,(offset-by 4)) :ecx)
+ (:andl -4 :ecx)))))))
+ (:tag
+ (assert (= 4 movitz::+movitz-fixnum-factor+))
+ (cond
+ ((and (eq 0 offset) (eq 0 index))
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3))
+ (:compile-form (:result-mode :eax) ,object)
+ (:movl (:eax ,(offset-by 4)) :ecx)
+ (:andl 7 :ecx)))
+ ((eq 0 offset)
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3))
+ (:compile-two-forms (:eax :ecx) ,object ,index)
+ (:movl (:eax :ecx ,(offset-by 4)) :ecx)
+ (:andl 7 :ecx)))
+ (t (let ((object-var (gensym "memref-object-")))
+ `(let ((,object-var ,object))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3))
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :eax)
+ (:addl :ebx :ecx)
+ (:movl (:eax :ecx ,(offset-by 4)) :ecx)
+ (:andl 7 :ecx)))))))
+ (:unsigned-byte32
+ (let ((prefixes (if (not physicalp)
+ ()
+ movitz:*compiler-physical-segment-prefix*))
+ (fix-endian (ecase (movitz:movitz-eval endian env)
+ ((:host :little) ())
+ (:big `((:bswap :ecx))))))
(assert (= 4 movitz::+movitz-fixnum-factor+))
(cond
((and (eq 0 offset) (eq 0 index))
- `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3))
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx
+ :type (unsigned-byte 32))
(:compile-form (:result-mode :eax) ,object)
- (:movl (:eax ,(offset-by 4)) :ecx)
- (:andl 7 :ecx)))
+ (,prefixes :movl (:eax ,(offset-by 4)) :ecx)
+ , at fix-endian))
((eq 0 offset)
- `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3))
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx
+ :type (unsigned-byte 32))
(:compile-two-forms (:eax :ecx) ,object ,index)
- (:movl (:eax :ecx ,(offset-by 4)) :ecx)
- (:andl 7 :ecx)))
+ (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx)
+ , at fix-endian))
(t (let ((object-var (gensym "memref-object-")))
`(let ((,object-var ,object))
- (with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx
+ :type (unsigned-byte 32))
(:compile-two-forms (:ecx :ebx) ,offset ,index)
(:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
(:load-lexical (:lexical-binding ,object-var) :eax)
(:addl :ebx :ecx)
- (:movl (:eax :ecx ,(offset-by 4)) :ecx)
- (:andl 7 :ecx)))))))
- (:unsigned-byte32
- (let ((endian (movitz:movitz-eval endian env))
- (prefixes (if (not physicalp)
- ()
- movitz:*compiler-physical-segment-prefix*)))
- (assert (member endian '(:host :little)))
- (assert (= 4 movitz::+movitz-fixnum-factor+))
- (cond
- ((and (eq 0 offset) (eq 0 index))
- `(with-inline-assembly (:returns :untagged-fixnum-ecx
- :type (unsigned-byte 32))
- (:compile-form (:result-mode :eax) ,object)
- (,prefixes :movl (:eax ,(offset-by 4)) :ecx)))
- ((eq 0 offset)
- `(with-inline-assembly (:returns :untagged-fixnum-ecx
- :type (unsigned-byte 32))
- (:compile-two-forms (:eax :ecx) ,object ,index)
- (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx)))
- (t (let ((object-var (gensym "memref-object-")))
- `(let ((,object-var ,object))
- (with-inline-assembly (:returns :untagged-fixnum-ecx
- :type (unsigned-byte 32))
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
- (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
- (:load-lexical (:lexical-binding ,object-var) :eax)
- (:addl :ebx :ecx)
- (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx))))))))
- (:lisp
- (let* ((localp (movitz:movitz-eval localp env))
- (prefixes (if localp
- nil
- movitz:*compiler-nonlocal-lispval-read-segment-prefix*)))
- (cond
- ((and (eql 0 index) (eql 0 offset))
- `(with-inline-assembly (:returns :register)
- (:compile-form (:result-mode :register) ,object)
- (,prefixes :movl ((:result-register) ,(offset-by 4)) (:result-register))))
- ((eql 0 offset)
- `(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :ecx) ,object ,index)
- ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
- `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx))
- (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax)))
- ((eql 0 index)
- `(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,offset)
- (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax)))
- (t (assert (not (movitz:movitz-constantp offset env)))
- (assert (not (movitz:movitz-constantp index env)))
- (let ((object-var (gensym "memref-object-")))
- (assert (= 4 movitz:+movitz-fixnum-factor+))
- `(let ((,object-var ,object))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
- (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
- (:load-lexical (:lexical-binding ,object-var) :eax)
- (:addl :ebx :ecx)
- (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax))))))))
- (:code-vector
- ;; A code-vector is like a normal lisp word pointer,
- ;; except it's known to point to a code-vector, and
- ;; the pointer value is offset by 2. The trick is to
- ;; perform this pointer arithmetics while never
- ;; keeping a non-lisp-word pointer in a register.
+ (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx)
+ , at fix-endian)))))))
+ (:lisp
+ (let* ((localp (movitz:movitz-eval localp env))
+ (prefixes (if localp
+ nil
+ movitz:*compiler-nonlocal-lispval-read-segment-prefix*)))
(cond
((and (eql 0 index) (eql 0 offset))
- `(with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :ebx) ,object)
- (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax)
- (:addl (:ebx ,(offset-by 4)) :eax)))
+ `(with-inline-assembly (:returns :register)
+ (:compile-form (:result-mode :register) ,object)
+ (,prefixes :movl ((:result-register) ,(offset-by 4)) (:result-register))))
((eql 0 offset)
`(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:ebx :ecx) ,object ,index)
+ (:compile-two-forms (:eax :ecx) ,object ,index)
,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
`((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx))
- (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax)
- (:addl (:ebx :ecx ,(offset-by 4)) :eax)))
+ (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax)))
((eql 0 index)
`(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:ebx :untagged-fixnum-ecx) ,object ,offset)
- (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax)
- (:addl (:ebx :ecx ,(offset-by 4)) :eax)))
- (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 :eax)
- (:load-lexical (:lexical-binding ,offset-var) :untagged-fixnum-ecx)
- (:load-lexical (:lexical-binding ,object-var) :ebx)
- (:load-lexical (:lexical-binding ,index-var) :edx)
- (:addl :edx :ecx)
- (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax)
- (:addl (:ebx :ecx ,(offset-by 4)) :eax)))))
- #+ignore
- (t (error "variable memref type :code-vector not implemented."))
- #+ignore
+ (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,offset)
+ (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax)))
(t (assert (not (movitz:movitz-constantp offset env)))
(assert (not (movitz:movitz-constantp index env)))
(let ((object-var (gensym "memref-object-")))
@@ -422,9 +376,60 @@
(:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
(:load-lexical (:lexical-binding ,object-var) :eax)
(:addl :ebx :ecx)
- (:movl (:eax :ecx ,(offset-by 4)) :eax)))))))
- (t (error "Unknown memref type: ~S" (movitz:movitz-eval type nil nil))
- form)))))))))
+ (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax))))))))
+ (:code-vector
+ ;; A code-vector is like a normal lisp word pointer,
+ ;; except it's known to point to a code-vector, and
+ ;; the pointer value is offset by 2. The trick is to
+ ;; perform this pointer arithmetics while never
+ ;; keeping a non-lisp-word pointer in a register.
+ (cond
+ ((and (eql 0 index) (eql 0 offset))
+ `(with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :ebx) ,object)
+ (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax)
+ (:addl (:ebx ,(offset-by 4)) :eax)))
+ ((eql 0 offset)
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ebx :ecx) ,object ,index)
+ ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
+ `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx))
+ (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax)
+ (:addl (:ebx :ecx ,(offset-by 4)) :eax)))
+ ((eql 0 index)
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ebx :untagged-fixnum-ecx) ,object ,offset)
+ (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax)
+ (:addl (:ebx :ecx ,(offset-by 4)) :eax)))
+ (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 :eax)
+ (:load-lexical (:lexical-binding ,offset-var) :untagged-fixnum-ecx)
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (:load-lexical (:lexical-binding ,index-var) :edx)
+ (:addl :edx :ecx)
+ (:movl ,(ldb (byte 32 0) (- movitz:+code-vector-word-offset+)) :eax)
+ (:addl (:ebx :ecx ,(offset-by 4)) :eax)))))
+ #+ignore
+ (t (error "variable memref type :code-vector not implemented."))
+ #+ignore
+ (t (assert (not (movitz:movitz-constantp offset env)))
+ (assert (not (movitz:movitz-constantp index env)))
+ (let ((object-var (gensym "memref-object-")))
+ (assert (= 4 movitz:+movitz-fixnum-factor+))
+ `(let ((,object-var ,object))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :eax)
+ (:addl :ebx :ecx)
+ (:movl (:eax :ecx ,(offset-by 4)) :eax)))))))
+ (t (error "Unknown memref type: ~S" (movitz:movitz-eval type nil nil))
+ form))))))))
(defun memref (object offset &key (index 0) (type :lisp) localp (endian :host))
(ecase type
@@ -451,374 +456,403 @@
(not (movitz:movitz-constantp localp env))
(not (movitz:movitz-constantp endian env)))
form
- (case (movitz::eval-form type)
- (:character
- (cond
- ((and (movitz:movitz-constantp value env)
- (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- (let ((value (movitz:movitz-eval value env)))
- (check-type value movitz::movitz-character)
- `(progn
- (with-inline-assembly (:returns :nothing)
- (:compile-form (:result-mode :ebx) ,object)
- (:movb ,(movitz:movitz-intern value)
- (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 1 (movitz:movitz-eval index env))))))
- ,value)))
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- `(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :ebx) ,value ,object)
- (:movb :ah (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 1 (movitz:movitz-eval index env)))))))
- ((movitz:movitz-constantp offset env)
- (let ((value-var (gensym "memref-value-")))
- `(let ((,value-var ,value))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:ebx :untagged-fixnum-ecx) ,object ,index)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- (:movb :ah (:ebx :ecx ,(+ (movitz:movitz-eval offset env))))))))
- (t (let ((object-var (gensym "memref-object-"))
- (offset-var (gensym "memref-offset-")))
- `(let ((,object-var ,object) (,offset-var ,offset))
- (with-inline-assembly (:returns :nothing)
- (:compile-two-forms (:ecx :eax) ,index ,value)
- (:load-lexical (:lexical-binding ,offset-var) :ebx)
- (:addl :ebx :ecx)
- (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
- (:load-lexical (:lexical-binding ,object-var) :ebx)
- (:movb :ah (:ebx :ecx))))))))
- (:unsigned-byte32
- (let ((endian (movitz:movitz-eval endian env)))
- (assert (member endian '(:host :little))))
- (assert (= 4 movitz::+movitz-fixnum-factor+))
- (cond
- ((and (movitz:movitz-constantp value env)
- (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- (let ((value (movitz:movitz-eval value env)))
- (check-type value (unsigned-byte 32))
- `(progn
- (with-inline-assembly (:returns :nothing)
- (:compile-form (:result-mode :ebx) ,object)
- (:movl ,value (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 4 (movitz:movitz-eval index env))))))
- ,value)))
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- `(with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,value ,object)
- (:movl :ecx (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 4 (movitz:movitz-eval index env)))))))
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp value env))
- (let ((value (movitz:movitz-eval value env)))
- (check-type value (unsigned-byte 32))
- `(progn
- (with-inline-assembly (:returns :nothing)
- (:compile-two-forms (:ecx :ebx) ,index ,object)
- (:movl ,value (:ebx :ecx ,(movitz:movitz-eval offset env))))
- ,value)))
- ((movitz:movitz-constantp offset env)
- (let ((value-var (gensym "memref-value-"))
- (object-var (gensym "memref-object-"))
- (index-var (gensym "memref-index-")))
- `(let ((,value-var ,value)
- (,object-var ,object)
- (,index-var ,index))
- (with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:load-lexical (:lexical-binding ,value-var) :untagged-fixnum-ecx)
- (:compile-two-forms (:ebx :eax) ,object-var ,index-var)
- (:movl :ecx (:eax :ebx ,(movitz:movitz-eval offset env)))))))
- (t (let ((value-var (gensym "memref-value-"))
- (object-var (gensym "memref-object-"))
- (offset-var (gensym "memref-offset-"))
- (index-var (gensym "memref-index-")))
- (assert (= 4 movitz:+movitz-fixnum-factor+))
- `(let ((,value-var ,value)
- (,object-var ,object)
- (,offset-var ,offset)
- (,index-var ,index))
- (with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- (:call-global-pf unbox-u32)
- (:compile-two-forms (:eax :edx) ,index-var ,offset-var)
- (:load-lexical (:lexical-binding ,object-var) :ebx)
- (:std)
- (:sarl ,movitz::+movitz-fixnum-shift+ :edx)
- (:addl :eax :edx) ; EDX = offset+index
- (:movl :ecx (:ebx :edx))
- (:movl :edi :edx)
- (:cld)))))))
- (:unsigned-byte16
- (let ((endian (ecase (movitz:movitz-eval endian env)
- ((:host :little) :little)
- (:big :big))))
- (cond
- ((and (movitz:movitz-constantp value env)
- (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- (let* ((host-value (movitz:movitz-eval value env))
- (value (ecase endian
- (:little host-value)
- (:big (dpb (ldb (byte 8 0) host-value)
- (byte 8 8)
- (ldb (byte 8 8) host-value))))))
- (check-type value (unsigned-byte 16))
- `(progn
- (with-inline-assembly (:returns :nothing)
- (:compile-form (:result-mode :ebx) ,object)
- (:movw ,value (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 2 (movitz:movitz-eval index env))))))
- ,value)))
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- `(with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,value ,object)
- ,@(ecase endian
- (:little nil)
- (:big `((:xchg :cl :ch))))
- (:movw :cx (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 2 (movitz:movitz-eval index env)))))))
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp 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))
- `(let ((,object-var ,object)
- (,index-var ,index))
- (with-inline-assembly (:returns :nothing)
- (: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-"))
- (index-var (gensym "memref-index-"))
- (object-var (gensym "memref-object-")))
- (if (<= 16 movitz:*compiler-allow-untagged-word-bits*)
- `(let ((,value-var ,value)
- (,object-var ,object)
- (,index-var ,index))
- (with-inline-assembly (:returns :untagged-fixnum-eax)
- (: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)
- (,object-var ,object)
- (,index-var ,index))
- (with-inline-assembly (:returns :nothing)
- (:compile-two-forms (:ebx :ecx) ,object-var ,index-var)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- (:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
- (:movl :edi :edx)
- (:std)
- (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
- ,@(ecase endian
- (:little nil)
- (:big `((:xchgb :al :ah))))
- (: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-"))
- (offset-var (gensym "memref-offset-"))
- (index-var (gensym "memref-index-")))
- (if (<= 16 movitz:*compiler-allow-untagged-word-bits*)
+ (multiple-value-bind (constant-index xindex)
+ (extract-constant-delta index env)
+ (multiple-value-bind (constant-offset xoffset)
+ (extract-constant-delta offset env)
+ (flet ((offset-by (element-size)
+ (+ constant-offset (* constant-index element-size))))
+ (case (movitz::movitz-eval type env)
+ (:character
+ (cond
+ ((and (movitz:movitz-constantp value env)
+ (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp index env))
+ (let ((value (movitz:movitz-eval value env)))
+ (check-type value movitz::movitz-character)
+ `(progn
+ (with-inline-assembly (:returns :nothing)
+ (:compile-form (:result-mode :ebx) ,object)
+ (:movb ,(movitz:movitz-intern value)
+ (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 1 (movitz:movitz-eval index env))))))
+ ,value)))
+ ((and (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp index env))
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ebx) ,value ,object)
+ (:movb :ah (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 1 (movitz:movitz-eval index env)))))))
+ ((movitz:movitz-constantp offset env)
+ (let ((value-var (gensym "memref-value-")))
+ `(let ((,value-var ,value))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ebx :untagged-fixnum-ecx) ,object ,index)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:movb :ah (:ebx :ecx ,(+ (movitz:movitz-eval offset env))))))))
+ (t (let ((object-var (gensym "memref-object-"))
+ (offset-var (gensym "memref-offset-")))
+ `(let ((,object-var ,object) (,offset-var ,offset))
+ (with-inline-assembly (:returns :nothing)
+ (:compile-two-forms (:ecx :eax) ,index ,value)
+ (:load-lexical (:lexical-binding ,offset-var) :ebx)
+ (:addl :ebx :ecx)
+ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (:movb :ah (:ebx :ecx))))))))
+ (:unsigned-byte32
+ (let ((endian (ecase (movitz:movitz-eval endian env)
+ ((:host :little) :little)
+ (:big :big))))
+ (assert (= 4 movitz::+movitz-fixnum-factor+))
+ (cond
+ ((and (movitz:movitz-constantp value env)
+ (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp index env))
+ (let ((value (movitz:movitz-eval value env)))
+ (check-type value (unsigned-byte 32))
+ `(progn
+ (with-inline-assembly (:returns :nothing)
+ (:compile-form (:result-mode :ebx) ,object)
+ (:movl ,value (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 4 (movitz:movitz-eval index env))))))
+ ,value)))
+ ((and (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp index env))
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,value ,object)
+ ,@(when (eq endian :big)
+ `((:bswap :ecx)))
+ (:movl :ecx (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 4 (movitz:movitz-eval index env)))))))
+ ((and (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp value env))
+ (let ((value (movitz:movitz-eval value env)))
+ (check-type value (unsigned-byte 32))
+ (let ((value (ecase endian
+ (:little value)
+ (:big (logior (ash (ldb (byte 8 0) value) 24)
+ (ash (ldb (byte 8 8) value) 16)
+ (ash (ldb (byte 8 16) value) 8)
+ (ash (ldb (byte 8 24) value) 0))))))
+ `(progn
+ (with-inline-assembly (:returns :nothing)
+ (:compile-two-forms (:ecx :ebx) ,index ,object)
+ (:movl ,value (:ebx :ecx ,(movitz:movitz-eval offset env))))
+ ,value))))
+ ((movitz:movitz-constantp offset env)
+ (let ((value-var (gensym "memref-value-"))
+ (object-var (gensym "memref-object-"))
+ (index-var (gensym "memref-index-")))
`(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-var ,index-var)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- (:andl ,(* movitz:+movitz-fixnum-factor+ #xffff) :eax)
- (:leal (:ebx (:ecx 2)) :ecx)
- (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
- (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
- (:load-lexical (:lexical-binding ,object-var) :ebx)
- (:movw :ax (:ebx :ecx))))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:load-lexical (:lexical-binding ,value-var) :untagged-fixnum-ecx)
+ (:compile-two-forms (:ebx :eax) ,object-var ,index-var)
+ ,@(when (eq endian :big)
+ `((:bswap :ecx)))
+ (:movl :ecx (:eax :ebx ,(movitz:movitz-eval offset env)))))))
+ (t (let ((value-var (gensym "memref-value-"))
+ (object-var (gensym "memref-object-"))
+ (offset-var (gensym "memref-offset-"))
+ (index-var (gensym "memref-index-")))
+ (assert (= 4 movitz:+movitz-fixnum-factor+))
+ `(let ((,value-var ,value)
+ (,object-var ,object)
+ (,offset-var ,offset)
+ (,index-var ,index))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:call-global-pf unbox-u32)
+ (:compile-two-forms (:eax :edx) ,index-var ,offset-var)
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ ,@(when (eq endian :big)
+ `((:bswap :ecx)))
+ (:std)
+ (:sarl ,movitz::+movitz-fixnum-shift+ :edx)
+ (:addl :eax :edx) ; EDX = offset+index
+ (:movl :ecx (:ebx :edx))
+ (:movl :edi :edx)
+ (:cld))))))))
+ (:unsigned-byte16
+ (let ((endian (ecase (movitz:movitz-eval endian env)
+ ((:host :little) :little)
+ (:big :big))))
+ (cond
+ ((and (movitz:movitz-constantp value env)
+ (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp index env))
+ (let* ((host-value (movitz:movitz-eval value env))
+ (value (ecase endian
+ (:little host-value)
+ (:big (dpb (ldb (byte 8 0) host-value)
+ (byte 8 8)
+ (ldb (byte 8 8) host-value))))))
+ (check-type value (unsigned-byte 16))
+ `(progn
+ (with-inline-assembly (:returns :nothing)
+ (:compile-form (:result-mode :ebx) ,object)
+ (:movw ,value (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 2 (movitz:movitz-eval index env))))))
+ ,value)))
+ ((and (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp index env))
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,value ,object)
+ ,@(ecase endian
+ (:little nil)
+ (:big `((:xchg :cl :ch))))
+ (:movw :cx (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 2 (movitz:movitz-eval index env)))))))
+ ((and (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp 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))
+ `(let ((,object-var ,object)
+ (,index-var ,index))
+ (with-inline-assembly (:returns :nothing)
+ (: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-"))
+ (index-var (gensym "memref-index-"))
+ (object-var (gensym "memref-object-")))
+ (if (<= 16 movitz:*compiler-allow-untagged-word-bits*)
+ `(let ((,value-var ,value)
+ (,object-var ,object)
+ (,index-var ,index))
+ (with-inline-assembly (:returns :untagged-fixnum-eax)
+ (: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)
+ (,object-var ,object)
+ (,index-var ,index))
+ (with-inline-assembly (:returns :nothing)
+ (:compile-two-forms (:ebx :ecx) ,object-var ,index-var)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
+ (:movl :edi :edx)
+ (:std)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
+ ,@(ecase endian
+ (:little nil)
+ (:big `((:xchgb :al :ah))))
+ (: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-"))
+ (offset-var (gensym "memref-offset-"))
+ (index-var (gensym "memref-index-")))
+ (if (<= 16 movitz:*compiler-allow-untagged-word-bits*)
+ `(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-var ,index-var)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:andl ,(* movitz:+movitz-fixnum-factor+ #xffff) :eax)
+ (:leal (:ebx (:ecx 2)) :ecx)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
+ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (:movw :ax (:ebx :ecx))))
+ `(let ((,value-var ,value)
+ (,object-var ,object)
+ (,offset-var ,offset)
+ (,index-var ,index))
+ (with-inline-assembly (:returns :nothing)
+ (:compile-two-forms (:ebx :ecx) ,offset-var ,index-var)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:leal (:ebx (:ecx 2)) :ecx)
+ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (:std)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
+ ,@(ecase endian
+ (:little nil)
+ (:big `((:xchgb :al :ah))))
+ (:movw :ax (:ebx :ecx))
+ (:shll ,movitz:+movitz-fixnum-shift+ :eax)
+ (:movl :edi :edx)
+ (:cld))
+ ,value-var)))))))
+ (:unsigned-byte8
+ (cond
+ ((and (movitz:movitz-constantp value env)
+ (eql 0 xoffset)
+ (eql 0 xindex))
+ (let ((value (movitz:movitz-eval value env)))
+ (check-type value (unsigned-byte 8))
+ `(progn
+ (with-inline-assembly (:returns :nothing)
+ (:compile-form (:result-mode :ebx) ,object)
+ (:movb ,value (:ebx ,(offset-by 1))))
+ ,value)))
+ ((eql 0 xindex)
+ (let ((value-var (gensym "memref-value-"))
+ (object-var (gensym "memref-object-"))
+ (offset-var (gensym "memref-offset-")))
`(let ((,value-var ,value)
(,object-var ,object)
- (,offset-var ,offset)
- (,index-var ,index))
+ (,offset-var ,xoffset))
(with-inline-assembly (:returns :nothing)
- (:compile-two-forms (:ebx :ecx) ,offset-var ,index-var)
+ (:load-lexical (:lexical-binding ,offset-var) :untagged-fixnum-ecx)
(:load-lexical (:lexical-binding ,value-var) :eax)
- (:leal (:ebx (:ecx 2)) :ecx)
- (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
(:load-lexical (:lexical-binding ,object-var) :ebx)
- (:std)
- (:shrl ,movitz:+movitz-fixnum-shift+ :eax)
- ,@(ecase endian
- (:little nil)
- (:big `((:xchgb :al :ah))))
- (:movw :ax (:ebx :ecx))
- (:shll ,movitz:+movitz-fixnum-shift+ :eax)
- (:movl :edi :edx)
- (:cld))
- ,value-var)))))))
- (:unsigned-byte8
- (cond
- ((and (movitz:movitz-constantp value env)
- (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- (let ((value (movitz:movitz-eval value env)))
- (check-type value (unsigned-byte 8))
- `(progn
- (with-inline-assembly (:returns :nothing)
- (:compile-form (:result-mode :ebx) ,object)
- (:movb ,value (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 1 (movitz:movitz-eval index env))))))
- ,value)))
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- `(with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:compile-two-forms (:ecx :ebx) ,value ,object)
- (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
- (:movb :cl (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 1 (movitz:movitz-eval index env)))))))
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp value env))
- (let ((value (movitz:movitz-eval value env)))
- (check-type value (unsigned-byte 8))
- `(progn
- (with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:compile-two-forms (:eax :ecx) ,object ,index)
- (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
- (:movb ,value (:eax :ecx ,(movitz:movitz-eval offset env))))
- value)))
- ((movitz:movitz-constantp offset env)
- (let ((value-var (gensym "memref-value-")))
- `(let ((,value-var ,value))
- (with-inline-assembly (:returns :nothing)
- (:compile-two-forms (:ebx :ecx) ,object ,index)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
- (:shll ,(- 8 movitz:+movitz-fixnum-shift+) :eax) ; value into :AH
- (:movb :ah (:ebx :ecx ,(movitz:movitz-eval offset env))))
- ,value-var)))
- (t (let ((value-var (gensym "memref-value-"))
- (object-var (gensym "memref-object-")))
- `(let ((,value-var ,value) (,object-var ,object))
- (with-inline-assembly (:returns :nothing)
- (:compile-two-forms (:ebx :ecx) ,offset ,index)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- (:addl :ebx :ecx)
- (:load-lexical (:lexical-binding ,object-var) :ebx) ; value into :AH
- (:shll ,(- 8 movitz:+movitz-fixnum-shift+) :eax)
- (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
- (:movb :ah (:ebx :ecx)))
- ,value-var)))))
- (:unsigned-byte14
- (cond
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- `(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :ebx) ,value ,object)
- (:andl ,(mask-field (byte 14 2) -1) :eax)
- (:movw :ax (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 4 (movitz:movitz-eval index env)))))))
- ((movitz:movitz-constantp offset env)
- (let ((value-var (gensym "memref-value-")))
- `(let ((,value-var ,value))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:ebx :ecx) ,object ,index)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2))
- `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx))
- (:andl ,(mask-field (byte 14 2) -1) :eax)
- (:movw :ax (:ebx :ecx ,(movitz:movitz-eval offset env)))))))
- (t (let ((value-var (gensym "memref-value-"))
- (object-var (gensym "memref-object-")))
- `(let ((,value-var ,value) (,object-var ,object))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
- `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx))
- (:addl :ebx :ecx) ; index += offset
- (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (:shll ,(- 8 movitz:+movitz-fixnum-shift+) :eax)
+ (:movb :ah (:ebx :ecx ,(offset-by 1))))
+ ,value-var)))
+ ((and (eql 0 xoffset) (eql 0 xindex))
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,value ,object)
+ (:movb :cl (:ebx ,(offset-by 1)))))
+ ((and (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp value env))
+ (let ((value (movitz:movitz-eval value env)))
+ (check-type value (unsigned-byte 8))
+ `(progn
+ (with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-two-forms (:eax :ecx) ,object ,index)
+ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:movb ,value (:eax :ecx ,(movitz:movitz-eval offset env))))
+ value)))
+ ((movitz:movitz-constantp offset env)
+ (let ((value-var (gensym "memref-value-")))
+ `(let ((,value-var ,value))
+ (with-inline-assembly (:returns :nothing)
+ (:compile-two-forms (:ebx :ecx) ,object ,index)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:shll ,(- 8 movitz:+movitz-fixnum-shift+) :eax) ; value into :AH
+ (:movb :ah (:ebx :ecx ,(movitz:movitz-eval offset env))))
+ ,value-var)))
+ (t (let ((value-var (gensym "memref-value-"))
+ (object-var (gensym "memref-object-")))
+ `(let ((,value-var ,value) (,object-var ,object))
+ (with-inline-assembly (:returns :nothing)
+ (:compile-two-forms (:ebx :ecx) ,offset ,index)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ (:addl :ebx :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :ebx) ; value into :AH
+ (:shll ,(- 8 movitz:+movitz-fixnum-shift+) :eax)
+ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:movb :ah (:ebx :ecx)))
+ ,value-var)))))
+ (:unsigned-byte14
+ (cond
+ ((and (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp index env))
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ebx) ,value ,object)
(:andl ,(mask-field (byte 14 2) -1) :eax)
- (:movl :ax (:ebx :ecx))))))))
- (:lisp
- (let* ((localp (movitz:movitz-eval localp env))
- (prefixes (if localp
- nil
- movitz:*compiler-nonlocal-lispval-write-segment-prefix*)))
- (cond
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- `(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :ebx) ,value ,object)
- (,prefixes :movl :eax (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 4 (movitz:movitz-eval index env)))))))
- ((movitz:movitz-constantp offset env)
- (let ((value-var (gensym "memref-value-")))
- `(let ((,value-var ,value))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:ebx :ecx) ,object ,index)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2))
- `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx))
- (,prefixes :movl :eax (:ebx :ecx ,(movitz:movitz-eval offset env)))))))
- (t (let ((value-var (gensym "memref-value-"))
- (object-var (gensym "memref-object-")))
- `(let ((,value-var ,value) (,object-var ,object))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
- `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx))
- (:addl :ebx :ecx) ; index += offset
- (:load-lexical (:lexical-binding ,object-var) :ebx)
- (,prefixes :movl :eax (:ebx :ecx)))))))))
- (:code-vector
- (let ((prefixes (if localp
- nil
- movitz:*compiler-nonlocal-lispval-write-segment-prefix*)))
- (cond
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- `(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :ebx) ,value ,object)
- (:movl ,movitz:+code-vector-word-offset+
- (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 4 (movitz:movitz-eval index env)))))
- (,prefixes
- :addl :eax (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 4 (movitz:movitz-eval index env)))))))
- ((movitz:movitz-constantp offset env)
- (let ((value-var (gensym "memref-value-")))
- `(let ((,value-var ,value))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:ebx :ecx) ,object ,index)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2))
- `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx))
- (:movl ,movitz:+code-vector-word-offset+
- (:ebx :ecx ,(movitz:movitz-eval offset env)))
- (,prefixes
- :addl :eax (:ebx :ecx ,(movitz:movitz-eval offset env)))))))
- (t (let ((value-var (gensym "memref-value-"))
- (object-var (gensym "memref-object-")))
- `(let ((,value-var ,value)
- (,object-var ,object))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
- `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx))
- (:addl :ebx :ecx) ; index += offset
- (:load-lexical (:lexical-binding ,object-var) :ebx)
- (:movl ,movitz:+code-vector-word-offset+ (:ebx :ecx))
- (,prefixes :addl :eax (:ebx :ecx)))))))))
- (t ;; (warn "Can't handle inline MEMREF: ~S" form)
- form))))
+ (:movw :ax (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 4 (movitz:movitz-eval index env)))))))
+ ((movitz:movitz-constantp offset env)
+ (let ((value-var (gensym "memref-value-")))
+ `(let ((,value-var ,value))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ebx :ecx) ,object ,index)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2))
+ `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx))
+ (:andl ,(mask-field (byte 14 2) -1) :eax)
+ (:movw :ax (:ebx :ecx ,(movitz:movitz-eval offset env)))))))
+ (t (let ((value-var (gensym "memref-value-"))
+ (object-var (gensym "memref-object-")))
+ `(let ((,value-var ,value) (,object-var ,object))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
+ `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx))
+ (:addl :ebx :ecx) ; index += offset
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (:andl ,(mask-field (byte 14 2) -1) :eax)
+ (:movl :ax (:ebx :ecx))))))))
+ (:lisp
+ (let* ((localp (movitz:movitz-eval localp env))
+ (prefixes (if localp
+ nil
+ movitz:*compiler-nonlocal-lispval-write-segment-prefix*)))
+ (cond
+ ((and (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp index env))
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ebx) ,value ,object)
+ (,prefixes :movl :eax (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 4 (movitz:movitz-eval index env)))))))
+ ((movitz:movitz-constantp offset env)
+ (let ((value-var (gensym "memref-value-")))
+ `(let ((,value-var ,value))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ebx :ecx) ,object ,index)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2))
+ `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx))
+ (,prefixes :movl :eax (:ebx :ecx ,(movitz:movitz-eval offset env)))))))
+ (t (let ((value-var (gensym "memref-value-"))
+ (object-var (gensym "memref-object-")))
+ `(let ((,value-var ,value) (,object-var ,object))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
+ `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx))
+ (:addl :ebx :ecx) ; index += offset
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (,prefixes :movl :eax (:ebx :ecx)))))))))
+ (:code-vector
+ (let ((prefixes (if localp
+ nil
+ movitz:*compiler-nonlocal-lispval-write-segment-prefix*)))
+ (cond
+ ((and (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp index env))
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ebx) ,value ,object)
+ (:movl ,movitz:+code-vector-word-offset+
+ (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 4 (movitz:movitz-eval index env)))))
+ (,prefixes
+ :addl :eax (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 4 (movitz:movitz-eval index env)))))))
+ ((movitz:movitz-constantp offset env)
+ (let ((value-var (gensym "memref-value-")))
+ `(let ((,value-var ,value))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ebx :ecx) ,object ,index)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2))
+ `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx))
+ (:movl ,movitz:+code-vector-word-offset+
+ (:ebx :ecx ,(movitz:movitz-eval offset env)))
+ (,prefixes
+ :addl :eax (:ebx :ecx ,(movitz:movitz-eval offset env)))))))
+ (t (let ((value-var (gensym "memref-value-"))
+ (object-var (gensym "memref-object-")))
+ `(let ((,value-var ,value)
+ (,object-var ,object))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
+ `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx))
+ (:addl :ebx :ecx) ; index += offset
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (:movl ,movitz:+code-vector-word-offset+ (:ebx :ecx))
+ (,prefixes :addl :eax (:ebx :ecx)))))))))
+ (t ;; (warn "Can't handle inline MEMREF: ~S" form)
+ form)))))))
(defun (setf memref) (value object offset &key (index 0) (type :lisp) localp (endian :host))
(ecase type
@@ -1165,3 +1199,34 @@
(defun %copy-words (destination source count &optional (start1 0) (start2 0))
(%copy-words destination source count start1 start2))
+
+;; (define-compiler-macro memrange (object ))
+
+(defun memrange (object offset index length type)
+ (ecase type
+ (:unsigned-byte8
+ (let ((vector (make-array length :element-type '(unsigned-byte 8))))
+ (loop for i upfrom index as j upfrom 0 repeat length
+ do (setf (aref vector j) (memref object offset :index i :type :unsigned-byte8)))
+ vector))))
+
+(defun (setf memrange) (value object offset index length type)
+ (ecase type
+ (:unsigned-byte8
+ (etypecase value
+ ((unsigned-byte 8)
+ (loop for i upfrom index repeat length
+ do (setf (memref object offset :index i :type :unsigned-byte8) value)))
+ (vector
+ (loop for i upfrom index as x across value repeat length
+ do (setf (memref object offset :index i :type :unsigned-byte8) x)))))
+ (:character
+ (etypecase value
+ (character
+ (loop for i upfrom index repeat length
+ do (setf (memref object offset :index i :type :character) value)))
+ (string
+ (loop for i upfrom index as x across value repeat length
+ do (setf (memref object offset :index i :type :character) x))))))
+ value)
+
More information about the Movitz-cvs
mailing list