X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmemory.lisp;h=6f5ef02d5b00855fc889655725e9eea4f6a98dd0;hb=670d28c10c178142146f6916c5fa0967732f3a8f;hp=ca8c2e28b0dc9328a3f117620e6b7c3d206e2640;hpb=29a9ccc860532b32c566aec095f570e999a9c52c;p=sbcl.git diff --git a/src/compiler/x86/memory.lisp b/src/compiler/x86/memory.lisp index ca8c2e2..6f5ef02 100644 --- a/src/compiler/x86/memory.lisp +++ b/src/compiler/x86/memory.lisp @@ -27,14 +27,14 @@ (loadw value object offset lowtag))) (define-vop (cell-set) (:args (object :scs (descriptor-reg)) - (value :scs (descriptor-reg any-reg))) + (value :scs (descriptor-reg any-reg))) (:variant-vars offset lowtag) (:policy :fast-safe) (:generator 4 (storew value object offset lowtag))) (define-vop (cell-setf) (:args (object :scs (descriptor-reg)) - (value :scs (descriptor-reg any-reg) :target result)) + (value :scs (descriptor-reg any-reg) :target result)) (:results (result :scs (descriptor-reg any-reg))) (:variant-vars offset lowtag) (:policy :fast-safe) @@ -43,7 +43,7 @@ (move result value))) (define-vop (cell-setf-fun) (:args (value :scs (descriptor-reg any-reg) :target result) - (object :scs (descriptor-reg))) + (object :scs (descriptor-reg))) (:results (result :scs (descriptor-reg any-reg))) (:variant-vars offset lowtag) (:policy :fast-safe) @@ -55,23 +55,23 @@ ;;; name is NIL, then that operation isn't defined. If the translate ;;; function is null, then we don't define a translation. (defmacro define-cell-accessors (offset lowtag - ref-op ref-trans set-op set-trans) + ref-op ref-trans set-op set-trans) `(progn ,@(when ref-op - `((define-vop (,ref-op cell-ref) - (:variant ,offset ,lowtag) - ,@(when ref-trans - `((:translate ,ref-trans)))))) + `((define-vop (,ref-op cell-ref) + (:variant ,offset ,lowtag) + ,@(when ref-trans + `((:translate ,ref-trans)))))) ,@(when set-op - `((define-vop (,set-op cell-setf) - (:variant ,offset ,lowtag) - ,@(when set-trans - `((:translate ,set-trans)))))))) + `((define-vop (,set-op cell-setf) + (:variant ,offset ,lowtag) + ,@(when set-trans + `((:translate ,set-trans)))))))) ;;; X86 special (define-vop (cell-xadd) (:args (object :scs (descriptor-reg) :to :result) - (value :scs (any-reg) :target result)) + (value :scs (any-reg) :target result)) (:results (result :scs (any-reg) :from (:argument 1))) (:result-types tagged-num) (:variant-vars offset lowtag) @@ -79,8 +79,8 @@ (:generator 4 (move result value) (inst xadd (make-ea :dword :base object - :disp (- (* offset n-word-bytes) lowtag)) - value))) + :disp (- (* offset n-word-bytes) lowtag)) + value))) ;;; SLOT-REF and SLOT-SET are used to define VOPs like CLOSURE-REF, ;;; where the offset is constant at compile time, but varies for @@ -94,38 +94,38 @@ (loadw value object (+ base offset) lowtag))) (define-vop (slot-set) (:args (object :scs (descriptor-reg)) - (value :scs (descriptor-reg any-reg immediate))) + (value :scs (descriptor-reg any-reg immediate))) (:variant-vars base lowtag) (:info offset) (:generator 4 (if (sc-is value immediate) - (let ((val (tn-value value))) - (etypecase val - (integer - (inst mov - (make-ea :dword :base object - :disp (- (* (+ base offset) n-word-bytes) lowtag)) - (fixnumize val))) - (symbol - (inst mov - (make-ea :dword :base object - :disp (- (* (+ base offset) n-word-bytes) lowtag)) - (+ nil-value (static-symbol-offset val)))) - (character - (inst mov - (make-ea :dword :base object - :disp (- (* (+ base offset) n-word-bytes) lowtag)) - (logior (ash (char-code val) n-widetag-bits) - base-char-widetag))))) - ;; Else, value not immediate. - (storew value object (+ base offset) lowtag)))) + (let ((val (tn-value value))) + (etypecase val + (integer + (inst mov + (make-ea :dword :base object + :disp (- (* (+ base offset) n-word-bytes) lowtag)) + (fixnumize val))) + (symbol + (inst mov + (make-ea :dword :base object + :disp (- (* (+ base offset) n-word-bytes) lowtag)) + (+ nil-value (static-symbol-offset val)))) + (character + (inst mov + (make-ea :dword :base object + :disp (- (* (+ base offset) n-word-bytes) lowtag)) + (logior (ash (char-code val) n-widetag-bits) + character-widetag))))) + ;; Else, value not immediate. + (storew value object (+ base offset) lowtag)))) (define-vop (slot-set-conditional) (:args (object :scs (descriptor-reg) :to :eval) - (old-value :scs (descriptor-reg any-reg) :target eax) - (new-value :scs (descriptor-reg any-reg) :target temp)) + (old-value :scs (descriptor-reg any-reg) :target eax) + (new-value :scs (descriptor-reg any-reg) :target temp)) (:temporary (:sc descriptor-reg :offset eax-offset - :from (:argument 1) :to :result :target result) eax) + :from (:argument 1) :to :result :target result) eax) (:temporary (:sc descriptor-reg :from (:argument 2) :to :result) temp) (:variant-vars base lowtag) (:results (result :scs (descriptor-reg))) @@ -134,14 +134,14 @@ (move eax old-value) (move temp new-value) (inst cmpxchg (make-ea :dword :base object - :disp (- (* (+ base offset) n-word-bytes) lowtag)) - temp) + :disp (- (* (+ base offset) n-word-bytes) lowtag)) + temp) (move result eax))) ;;; X86 special (define-vop (slot-xadd) (:args (object :scs (descriptor-reg) :to :result) - (value :scs (any-reg) :target result)) + (value :scs (any-reg) :target result)) (:results (result :scs (any-reg) :from (:argument 1))) (:result-types tagged-num) (:variant-vars base lowtag) @@ -149,5 +149,5 @@ (:generator 4 (move result value) (inst xadd (make-ea :dword :base object - :disp (- (* (+ base offset) n-word-bytes) lowtag)) - value))) + :disp (- (* (+ base offset) n-word-bytes) lowtag)) + value)))