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