X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fmemory.lisp;h=4a9a14a8b3de066b62099077b607ac314a7a60ce;hb=d306e2d23b38487488eb93881dad836e439e0c77;hp=21670d735d58f68305683e01c2134f6fd68910ba;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/x86/memory.lisp b/src/compiler/x86/memory.lisp index 21670d7..4a9a14a 100644 --- a/src/compiler/x86/memory.lisp +++ b/src/compiler/x86/memory.lisp @@ -12,14 +12,11 @@ (in-package "SB!VM") -(file-comment - "$Header$") - -;;; Cell-Ref and Cell-Set are used to define VOPs like CAR, where the +;;; CELL-REF and CELL-SET are used to define VOPs like CAR, where the ;;; offset to be read or written is a property of the VOP used. -;;; Cell-Setf is similar to Cell-Set, but delivers the new value as -;;; the result. Cell-Setf-Function takes its arguments as if it were a -;;; setf function (new value first, as apposed to a setf macro, which +;;; CELL-SETF is similar to CELL-SET, but delivers the new value as +;;; the result. CELL-SETF-FUN takes its arguments as if it were a +;;; SETF function (new value first, as apposed to a SETF macro, which ;;; takes the new value last). (define-vop (cell-ref) (:args (object :scs (descriptor-reg))) @@ -30,23 +27,23 @@ (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) (:generator 4 (storew value object offset lowtag) (move result value))) -(define-vop (cell-setf-function) +(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) @@ -54,39 +51,39 @@ (storew value object offset lowtag) (move result value))) -;;; Define accessor VOPs for some cells in an object. If the operation name -;;; is NIL, then that operation isn't defined. If the translate function is -;;; null, then we don't define a translation. +;;; Define accessor VOPs for some cells in an object. If the operation +;;; 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) (:policy :fast-safe) (:generator 4 (move result value) - (inst xadd (make-ea :dword :base object - :disp (- (* offset word-bytes) lowtag)) - value))) + (inst xadd (make-ea-for-object-slot object offset 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 different uses. +;;; SLOT-REF and SLOT-SET are used to define VOPs like CLOSURE-REF, +;;; where the offset is constant at compile time, but varies for +;;; different uses. (define-vop (slot-ref) (:args (object :scs (descriptor-reg))) (:results (value :scs (descriptor-reg any-reg))) @@ -96,38 +93,18 @@ (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) word-bytes) lowtag)) - (fixnumize val))) - (symbol - (inst mov - (make-ea :dword :base object - :disp (- (* (+ base offset) word-bytes) lowtag)) - (+ *nil-value* (static-symbol-offset val)))) - (character - (inst mov - (make-ea :dword :base object - :disp (- (* (+ base offset) word-bytes) lowtag)) - (logior (ash (char-code val) type-bits) - base-char-type))))) - ;; Else, value not immediate. - (storew value object (+ base offset) lowtag)))) + (storew (encode-value-if-immediate 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))) @@ -135,21 +112,19 @@ (:generator 4 (move eax old-value) (move temp new-value) - (inst cmpxchg (make-ea :dword :base object - :disp (- (* (+ base offset) word-bytes) lowtag)) - temp) + (inst cmpxchg (make-ea-for-object-slot object (+ base offset) 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) (:info offset) (:generator 4 (move result value) - (inst xadd (make-ea :dword :base object - :disp (- (* (+ base offset) word-bytes) lowtag)) - value))) + (inst xadd (make-ea-for-object-slot object (+ base offset) lowtag) + value)))