X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fmips%2Fcell.lisp;h=04689c3126146d479c8dd4e61baa51d0bf3b5c5b;hb=0a2d9c98c53cfe7b3874ca96b11dd629a360aa42;hp=79b2bbead8b5dff0ba0d448a6fec5a42d957181e;hpb=6f409fdfbd3d4a0c5c540de5a9371388c585cacb;p=sbcl.git diff --git a/src/compiler/mips/cell.lisp b/src/compiler/mips/cell.lisp index 79b2bbe..04689c3 100644 --- a/src/compiler/mips/cell.lisp +++ b/src/compiler/mips/cell.lisp @@ -31,6 +31,7 @@ (:generator 1 (storew value object offset lowtag))) +(define-vop (init-slot set-slot)) ;;;; Symbol hacking VOPs: @@ -60,7 +61,7 @@ (loadw value obj-temp symbol-value-slot other-pointer-lowtag) (let ((err-lab (generate-error-code vop unbound-symbol-error obj-temp))) (inst xor temp value unbound-marker-widetag) - (inst beq temp zero-tn err-lab) + (inst beq temp err-lab) (inst nop)))) ;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell is bound. @@ -78,8 +79,8 @@ (loadw value object symbol-value-slot other-pointer-lowtag) (inst xor temp value unbound-marker-widetag) (if not-p - (inst beq temp zero-tn target) - (inst bne temp zero-tn target)) + (inst beq temp target) + (inst bne temp target)) (inst nop))) (define-vop (fast-symbol-value cell-ref) @@ -91,19 +92,24 @@ (:policy :fast-safe) (:translate symbol-hash) (:args (symbol :scs (descriptor-reg))) + (:temporary (:scs (non-descriptor-reg)) temp) (:results (res :scs (any-reg))) (:result-types positive-fixnum) - (:temporary (:scs (any-reg)) temp) (: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 lowtag selection magic that is required to ;; ensure this is explained in the comment in objdef.lisp - ;; - ;; wow, MIPS sucks (or I do) -- CSR, 2004-05-20 - (inst li temp (fixnumize -1)) - (loadw res symbol symbol-hash-slot other-pointer-lowtag) - (inst and res temp))) + (loadw temp symbol symbol-hash-slot other-pointer-lowtag) + (inst srl temp n-fixnum-tag-bits) + (inst sll res temp n-fixnum-tag-bits))) + +;;; On unithreaded builds these are just copies of the non-global versions. +(define-vop (%set-symbol-global-value set)) +(define-vop (symbol-global-value symbol-value) + (:translate symbol-global-value)) +(define-vop (fast-symbol-global-value fast-symbol-value) + (:translate symbol-global-value)) ;;;; Fdefinition (fdefn) objects. @@ -136,7 +142,7 @@ (load-type type function (- fun-pointer-lowtag)) (inst nop) (inst xor type simple-fun-header-widetag) - (inst beq type zero-tn normal-fn) + (inst beq type normal-fn) (inst addu lip function (- (ash simple-fun-code-offset word-shift) fun-pointer-lowtag)) @@ -184,8 +190,8 @@ (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) - (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (inst addu bsp-tn bsp-tn (* -2 n-word-bytes)))) @@ -203,13 +209,13 @@ (emit-label loop) (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) - (inst beq symbol zero-tn skip) + (inst beq symbol skip) (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) - (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (emit-label skip) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (inst addu bsp-tn bsp-tn (* -2 n-word-bytes)) (inst bne where bsp-tn loop) (inst nop) @@ -232,15 +238,17 @@ 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 fun-pointer-lowtag)) - (define-vop (closure-ref slot-ref) (:variant closure-info-offset fun-pointer-lowtag)) (define-vop (closure-init slot-set) (:variant closure-info-offset fun-pointer-lowtag)) +(define-vop (closure-init-from-fp) + (:args (object :scs (descriptor-reg))) + (:info offset) + (:generator 4 + (storew cfp-tn object (+ closure-info-offset offset) fun-pointer-lowtag))) ;;;; Value Cell hackery. @@ -258,11 +266,12 @@ (:policy :fast-safe) (:translate %instance-length) (:args (struct :scs (descriptor-reg))) + (:temporary (:scs (non-descriptor-reg)) temp) (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 4 - (loadw res struct 0 instance-pointer-lowtag) - (inst srl res n-widetag-bits))) + (loadw temp struct 0 instance-pointer-lowtag) + (inst srl res temp n-widetag-bits))) (define-full-reffer instance-index-ref * instance-slots-offset instance-pointer-lowtag (descriptor-reg any-reg) * %instance-ref) @@ -297,7 +306,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset n-widetag-bits) - (inst sll offset 2) + (inst sll offset n-fixnum-tag-bits) (inst subu offset index) (inst subu offset n-word-bytes) (inst addu lip offset object) @@ -318,7 +327,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset n-widetag-bits) - (inst sll offset 2) + (inst sll offset n-fixnum-tag-bits) (inst subu offset index) (inst subu offset n-word-bytes) (inst addu lip offset object) @@ -339,7 +348,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset n-widetag-bits) - (inst sll offset 2) + (inst sll offset n-fixnum-tag-bits) (inst subu offset index) (inst subu offset n-word-bytes) (inst addu lip offset object) @@ -360,7 +369,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset n-widetag-bits) - (inst sll offset 2) + (inst sll offset n-fixnum-tag-bits) (inst subu offset index) (inst subu offset n-word-bytes) (inst addu lip offset object) @@ -382,7 +391,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset n-widetag-bits) - (inst sll offset 2) + (inst sll offset n-fixnum-tag-bits) (inst subu offset index) (inst subu offset (* 2 n-word-bytes)) (inst addu lip offset object) @@ -411,7 +420,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset n-widetag-bits) - (inst sll offset 2) + (inst sll offset n-fixnum-tag-bits) (inst subu offset index) (inst subu offset (* 2 n-word-bytes)) (inst addu lip offset object) @@ -441,7 +450,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset n-widetag-bits) - (inst sll offset 2) + (inst sll offset n-fixnum-tag-bits) (inst subu offset index) (inst subu offset (* 2 n-word-bytes)) (inst addu lip offset object) @@ -470,7 +479,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset n-widetag-bits) - (inst sll offset 2) + (inst sll offset n-fixnum-tag-bits) (inst subu offset index) (inst subu offset (* 2 n-word-bytes)) (inst addu lip offset object) @@ -506,7 +515,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset n-widetag-bits) - (inst sll offset 2) + (inst sll offset n-fixnum-tag-bits) (inst subu offset index) (inst subu offset (* 4 n-word-bytes)) (inst addu lip offset object) @@ -569,7 +578,7 @@ (:generator 5 (loadw offset object 0 instance-pointer-lowtag) (inst srl offset n-widetag-bits) - (inst sll offset 2) + (inst sll offset n-fixnum-tag-bits) (inst subu offset index) (inst subu offset (* 4 n-word-bytes)) (inst addu lip offset object)