X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fmemory.lisp;h=d80237aee58214f5fde624872a997be212b72396;hb=559d0ded238d8ec852fcd485656ef14578fc405f;hp=ca8c2e28b0dc9328a3f117620e6b7c3d206e2640;hpb=4ebdc81b1a9c6dbed6e98b112afc8dd32b17a2dd;p=sbcl.git diff --git a/src/compiler/x86-64/memory.lisp b/src/compiler/x86-64/memory.lisp index ca8c2e2..d80237a 100644 --- a/src/compiler/x86-64/memory.lisp +++ b/src/compiler/x86-64/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,34 @@ (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))) + (:temporary (:sc unsigned-reg) temp) (: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))) + (move-immediate (make-ea :qword :base object + :disp (- (* (+ base offset) n-word-bytes) + lowtag)) + (etypecase val + (integer + (fixnumize val)) + (symbol + (+ nil-value (static-symbol-offset val))) + (character + (logior (ash (char-code val) n-widetag-bits) + character-widetag))) + temp)) + ;; 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 +130,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 +145,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)))