X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcell.lisp;h=f34e9ac297fc1acd7bd97b63044a883aa7b260b9;hb=b05ccdd91520249de6b465e226d3708089e541dc;hp=336b5dc8d66635ba8d05f630e98966a9b0bf061c;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 336b5dc..f34e9ac 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -10,9 +10,6 @@ ;;;; files for more information. (in-package "SB!VM") - -(file-comment - "$Header$") ;;;; data object ref/set stuff @@ -37,19 +34,19 @@ (integer (inst mov (make-ea :dword :base object - :disp (- (* offset word-bytes) lowtag)) + :disp (- (* offset n-word-bytes) lowtag)) (fixnumize val))) (symbol (inst mov (make-ea :dword :base object - :disp (- (* offset word-bytes) lowtag)) - (+ *nil-value* (static-symbol-offset val)))) + :disp (- (* offset n-word-bytes) lowtag)) + (+ nil-value (static-symbol-offset val)))) (character (inst mov (make-ea :dword :base object - :disp (- (* offset word-bytes) lowtag)) - (logior (ash (char-code val) type-bits) - base-char-type))))) + :disp (- (* offset n-word-bytes) lowtag)) + (logior (ash (char-code val) n-widetag-bits) + base-char-widetag))))) ;; Else, value not immediate. (storew value object offset lowtag)))) @@ -60,7 +57,7 @@ ;;; The compiler likes to be able to directly SET symbols. (define-vop (set cell-set) - (:variant symbol-value-slot other-pointer-type)) + (:variant symbol-value-slot other-pointer-lowtag)) ;;; Do a cell ref with an error check for being unbound. (define-vop (checked-cell-ref) @@ -82,18 +79,18 @@ (:save-p :compute-only) (:generator 9 (let ((err-lab (generate-error-code vop unbound-symbol-error object))) - (loadw value object symbol-value-slot other-pointer-type) - (inst cmp value unbound-marker-type) + (loadw value object symbol-value-slot other-pointer-lowtag) + (inst cmp value unbound-marker-widetag) (inst jmp :e err-lab)))) (define-vop (fast-symbol-value cell-ref) - (:variant symbol-value-slot other-pointer-type) + (:variant symbol-value-slot other-pointer-lowtag) (:policy :fast) (:translate symbol-value)) (defknown fast-symbol-value-xadd (symbol fixnum) fixnum ()) (define-vop (fast-symbol-value-xadd cell-xadd) - (:variant symbol-value-slot other-pointer-type) + (:variant symbol-value-slot other-pointer-lowtag) (:policy :fast) (:translate fast-symbol-value-xadd) (:arg-types * tagged-num)) @@ -106,8 +103,8 @@ (:info target not-p) (:temporary (:sc descriptor-reg :from (:argument 0)) value) (:generator 9 - (loadw value object symbol-value-slot other-pointer-type) - (inst cmp value unbound-marker-type) + (loadw value object symbol-value-slot other-pointer-lowtag) + (inst cmp value unbound-marker-widetag) (inst jmp (if not-p :e :ne) target))) (define-vop (symbol-hash) @@ -117,56 +114,54 @@ (:results (res :scs (any-reg))) (:result-types positive-fixnum) (:generator 2 - ;; The symbol-hash slot of NIL holds NIL because it is also the cdr slot, - ;; so we have to strip off the two low bits to make sure it is a fixnum. + ;; The symbol-hash slot of NIL holds NIL because it is also the + ;; cdr slot, so we have to strip off the two low bits to make sure + ;; it is a fixnum. ;; ;; FIXME: Is this still true? It seems to me from my reading of ;; the DEFINE-PRIMITIVE-OBJECT in objdef.lisp that the symbol-hash ;; is the second slot, and offset 0 = tags and stuff (and CAR slot in ;; a CONS), offset 1 = value slot (and CDR slot in a CONS), and ;; offset 2 = hash slot. - (loadw res symbol symbol-hash-slot other-pointer-type) + (loadw res symbol symbol-hash-slot other-pointer-lowtag) (inst and res (lognot #b11)))) -;;;; fdefinition (fdefn) objects +;;;; fdefinition (FDEFN) objects -(define-vop (fdefn-function cell-ref) ; /pfw - alpha - (:variant fdefn-function-slot other-pointer-type)) +(define-vop (fdefn-fun cell-ref) ; /pfw - alpha + (:variant fdefn-fun-slot other-pointer-lowtag)) -(define-vop (safe-fdefn-function) +(define-vop (safe-fdefn-fun) (:args (object :scs (descriptor-reg) :to (:result 1))) (:results (value :scs (descriptor-reg any-reg))) (:vop-var vop) (:save-p :compute-only) (:generator 10 - (loadw value object fdefn-function-slot other-pointer-type) - (inst cmp value *nil-value*) - ;; FIXME: UNDEFINED-SYMBOL-ERROR seems to actually be for symbols with no - ;; function value, not, as the name might suggest, symbols with no ordinary - ;; value. Perhaps the name could be made more mnemonic? - (let ((err-lab (generate-error-code vop undefined-symbol-error object))) + (loadw value object fdefn-fun-slot other-pointer-lowtag) + (inst cmp value nil-value) + (let ((err-lab (generate-error-code vop undefined-fun-error object))) (inst jmp :e err-lab)))) -(define-vop (set-fdefn-function) +(define-vop (set-fdefn-fun) (:policy :fast-safe) - (:translate (setf fdefn-function)) + (:translate (setf fdefn-fun)) (:args (function :scs (descriptor-reg) :target result) (fdefn :scs (descriptor-reg))) (:temporary (:sc unsigned-reg) raw) (:temporary (:sc byte-reg) type) (:results (result :scs (descriptor-reg))) (:generator 38 - (load-type type function (- function-pointer-type)) + (load-type type function (- fun-pointer-lowtag)) (inst lea raw (make-ea :byte :base function - :disp (- (* function-code-offset word-bytes) - function-pointer-type))) - (inst cmp type function-header-type) + :disp (- (* simple-fun-code-offset n-word-bytes) + fun-pointer-lowtag))) + (inst cmp type simple-fun-header-widetag) (inst jmp :e normal-fn) (inst lea raw (make-fixup (extern-alien-name "closure_tramp") :foreign)) NORMAL-FN - (storew function fdefn fdefn-function-slot other-pointer-type) - (storew raw fdefn fdefn-raw-addr-slot other-pointer-type) + (storew function fdefn fdefn-fun-slot other-pointer-lowtag) + (storew raw fdefn fdefn-raw-addr-slot other-pointer-lowtag) (move result function))) (define-vop (fdefn-makunbound) @@ -175,9 +170,9 @@ (:args (fdefn :scs (descriptor-reg) :target result)) (:results (result :scs (descriptor-reg))) (:generator 38 - (storew *nil-value* fdefn fdefn-function-slot other-pointer-type) + (storew nil-value fdefn fdefn-fun-slot other-pointer-lowtag) (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign) - fdefn fdefn-raw-addr-slot other-pointer-type) + fdefn fdefn-raw-addr-slot other-pointer-lowtag) (move result fdefn))) ;;;; binding and unbinding @@ -192,12 +187,12 @@ (:temporary (:sc unsigned-reg) temp bsp) (:generator 5 (load-symbol-value bsp *binding-stack-pointer*) - (loadw temp symbol symbol-value-slot other-pointer-type) - (inst add bsp (* binding-size word-bytes)) + (loadw temp symbol symbol-value-slot other-pointer-lowtag) + (inst add bsp (* binding-size n-word-bytes)) (store-symbol-value bsp *binding-stack-pointer*) (storew temp bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) - (storew val symbol symbol-value-slot other-pointer-type))) + (storew val symbol symbol-value-slot other-pointer-lowtag))) (define-vop (unbind) (:temporary (:sc unsigned-reg) symbol value bsp) @@ -205,9 +200,9 @@ (load-symbol-value bsp *binding-stack-pointer*) (loadw symbol bsp (- binding-symbol-slot binding-size)) (loadw value bsp (- binding-value-slot binding-size)) - (storew value symbol symbol-value-slot other-pointer-type) + (storew value symbol symbol-value-slot other-pointer-lowtag) (storew 0 bsp (- binding-symbol-slot binding-size)) - (inst sub bsp (* binding-size word-bytes)) + (inst sub bsp (* binding-size n-word-bytes)) (store-symbol-value bsp *binding-stack-pointer*))) (define-vop (unbind-to-here) @@ -223,11 +218,11 @@ (inst or symbol symbol) (inst jmp :z skip) (loadw value bsp (- binding-value-slot binding-size)) - (storew value symbol symbol-value-slot other-pointer-type) + (storew value symbol symbol-value-slot other-pointer-lowtag) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP - (inst sub bsp (* binding-size word-bytes)) + (inst sub bsp (* binding-size n-word-bytes)) (inst cmp where bsp) (inst jmp :ne loop) (store-symbol-value bsp *binding-stack-pointer*) @@ -237,33 +232,33 @@ ;;;; closure indexing (define-full-reffer closure-index-ref * - closure-info-offset function-pointer-type + closure-info-offset fun-pointer-lowtag (any-reg descriptor-reg) * %closure-index-ref) (define-full-setter set-funcallable-instance-info * - funcallable-instance-info-offset function-pointer-type + funcallable-instance-info-offset fun-pointer-lowtag (any-reg descriptor-reg) * %set-funcallable-instance-info) (define-full-reffer funcallable-instance-info * - funcallable-instance-info-offset function-pointer-type + funcallable-instance-info-offset fun-pointer-lowtag (descriptor-reg any-reg) * %funcallable-instance-info) (define-vop (funcallable-instance-lexenv cell-ref) - (:variant funcallable-instance-lexenv-slot function-pointer-type)) + (:variant funcallable-instance-lexenv-slot fun-pointer-lowtag)) (define-vop (closure-ref slot-ref) - (:variant closure-info-offset function-pointer-type)) + (:variant closure-info-offset fun-pointer-lowtag)) (define-vop (closure-init slot-set) - (:variant closure-info-offset function-pointer-type)) + (:variant closure-info-offset fun-pointer-lowtag)) ;;;; value cell hackery (define-vop (value-cell-ref cell-ref) - (:variant value-cell-value-slot other-pointer-type)) + (:variant value-cell-value-slot other-pointer-lowtag)) (define-vop (value-cell-set cell-set) - (:variant value-cell-value-slot other-pointer-type)) + (:variant value-cell-value-slot other-pointer-lowtag)) ;;;; structure hackery @@ -274,11 +269,11 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 4 - (loadw res struct 0 instance-pointer-type) - (inst shr res type-bits))) + (loadw res struct 0 instance-pointer-lowtag) + (inst shr res n-widetag-bits))) (define-vop (instance-ref slot-ref) - (:variant instance-slots-offset instance-pointer-type) + (:variant instance-slots-offset instance-pointer-lowtag) (:policy :fast-safe) (:translate %instance-ref) (:arg-types instance (:constant index))) @@ -286,56 +281,19 @@ (define-vop (instance-set slot-set) (:policy :fast-safe) (:translate %instance-set) - (:variant instance-slots-offset instance-pointer-type) + (:variant instance-slots-offset instance-pointer-lowtag) (:arg-types instance (:constant index) *)) (define-full-reffer instance-index-ref * instance-slots-offset - instance-pointer-type (any-reg descriptor-reg) * %instance-ref) + instance-pointer-lowtag (any-reg descriptor-reg) * %instance-ref) (define-full-setter instance-index-set * instance-slots-offset - instance-pointer-type (any-reg descriptor-reg) * %instance-set) - -(defknown sb!kernel::%instance-set-conditional (instance index t t) t - (unsafe)) - -(define-vop (instance-set-conditional-c slot-set-conditional) - (:policy :fast-safe) - (:translate sb!kernel::%instance-set-conditional) - (:variant instance-slots-offset instance-pointer-type) - (:arg-types instance (:constant index) * *)) - -(define-vop (instance-set-conditional) - (:translate sb!kernel::%instance-set-conditional) - (:args (object :scs (descriptor-reg) :to :eval) - (slot :scs (any-reg) :to :result) - (old-value :scs (descriptor-reg any-reg) :target eax) - (new-value :scs (descriptor-reg any-reg) :target temp)) - (:arg-types instance positive-fixnum * *) - (:temporary (:sc descriptor-reg :offset eax-offset - :from (:argument 1) :to :result :target result) eax) - (:temporary (:sc descriptor-reg :from (:argument 2) :to :result) temp) - (:results (result :scs (descriptor-reg))) - (:policy :fast-safe) - (:generator 5 - (move eax old-value) - (move temp new-value) - (inst cmpxchg (make-ea :dword :base object :index slot :scale 1 - :disp (- (* instance-slots-offset word-bytes) - instance-pointer-type)) - temp) - (move result eax))) - -(defknown %instance-xadd (instance index fixnum) fixnum ()) -(define-vop (instance-xadd-c slot-xadd) - (:policy :fast-safe) - (:translate %instance-xadd) - (:variant instance-slots-offset instance-pointer-type) - (:arg-types instance (:constant index) tagged-num)) + instance-pointer-lowtag (any-reg descriptor-reg) * %instance-set) ;;;; code object frobbing -(define-full-reffer code-header-ref * 0 other-pointer-type +(define-full-reffer code-header-ref * 0 other-pointer-lowtag (any-reg descriptor-reg) * code-header-ref) -(define-full-setter code-header-set * 0 other-pointer-type +(define-full-setter code-header-set * 0 other-pointer-lowtag (any-reg descriptor-reg) * code-header-set)