X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcell.lisp;h=f34e9ac297fc1acd7bd97b63044a883aa7b260b9;hb=b05ccdd91520249de6b465e226d3708089e541dc;hp=4ecdedf22be23998fc3cebbfa541f10d13c40e02;hpb=6fb6e66f531dfb6140ec3e0cc8f84f6ecd1927ca;p=sbcl.git diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 4ecdedf..f34e9ac 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -34,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)) + :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)))) @@ -80,7 +80,7 @@ (:generator 9 (let ((err-lab (generate-error-code vop unbound-symbol-error object))) (loadw value object symbol-value-slot other-pointer-lowtag) - (inst cmp value unbound-marker-type) + (inst cmp value unbound-marker-widetag) (inst jmp :e err-lab)))) (define-vop (fast-symbol-value cell-ref) @@ -104,7 +104,7 @@ (:temporary (:sc descriptor-reg :from (:argument 0)) value) (:generator 9 (loadw value object symbol-value-slot other-pointer-lowtag) - (inst cmp value unbound-marker-type) + (inst cmp value unbound-marker-widetag) (inst jmp (if not-p :e :ne) target))) (define-vop (symbol-hash) @@ -139,10 +139,7 @@ (:generator 10 (loadw value object fdefn-fun-slot other-pointer-lowtag) (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))) + (let ((err-lab (generate-error-code vop undefined-fun-error object))) (inst jmp :e err-lab)))) (define-vop (set-fdefn-fun) @@ -157,9 +154,9 @@ (load-type type function (- fun-pointer-lowtag)) (inst lea raw (make-ea :byte :base function - :disp (- (* simple-fun-code-offset word-bytes) + :disp (- (* simple-fun-code-offset n-word-bytes) fun-pointer-lowtag))) - (inst cmp type simple-fun-header-type) + (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 @@ -191,7 +188,7 @@ (:generator 5 (load-symbol-value bsp *binding-stack-pointer*) (loadw temp symbol symbol-value-slot other-pointer-lowtag) - (inst add bsp (* binding-size word-bytes)) + (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)) @@ -205,7 +202,7 @@ (loadw value bsp (- binding-value-slot binding-size)) (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) @@ -225,7 +222,7 @@ (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*) @@ -273,7 +270,7 @@ (:result-types positive-fixnum) (:generator 4 (loadw res struct 0 instance-pointer-lowtag) - (inst shr res type-bits))) + (inst shr res n-widetag-bits))) (define-vop (instance-ref slot-ref) (:variant instance-slots-offset instance-pointer-lowtag) @@ -292,43 +289,6 @@ (define-full-setter instance-index-set * instance-slots-offset instance-pointer-lowtag (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-lowtag) - (: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-lowtag)) - 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-lowtag) - (:arg-types instance (:constant index) tagged-num)) ;;;; code object frobbing