X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Fcell.lisp;h=c9613aabcab82e96673d3926cec1cd89b17b1826;hb=57d30b9b5a4b2be52431e0a8daaf81d409d146a9;hp=250098cdd986fb02546219b96906ea8977cbee16;hpb=b05ccdd91520249de6b465e226d3708089e541dc;p=sbcl.git diff --git a/src/compiler/sparc/cell.lisp b/src/compiler/sparc/cell.lisp index 250098c..c9613aa 100644 --- a/src/compiler/sparc/cell.lisp +++ b/src/compiler/sparc/cell.lisp @@ -23,12 +23,14 @@ (define-vop (set-slot) (:args (object :scs (descriptor-reg)) - (value :scs (descriptor-reg any-reg))) + (value :scs (descriptor-reg any-reg))) (:info name offset lowtag) (:ignore name) (:results) (:generator 1 (storew value object offset lowtag))) + +(define-vop (init-slot set-slot)) ;;;; Symbol hacking VOPs: @@ -79,6 +81,26 @@ (:policy :fast) (:translate symbol-value)) +(define-vop (symbol-hash) + (:policy :fast-safe) + (:translate symbol-hash) + (:args (symbol :scs (descriptor-reg))) + (: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 lowtag selection magic that is required to + ;; ensure this is explained in the comment in objdef.lisp + (loadw res symbol symbol-hash-slot other-pointer-lowtag) + (inst andn res res fixnum-tag-mask))) + +;;; 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. (define-vop (fdefn-fun cell-ref) @@ -102,7 +124,7 @@ (:policy :fast-safe) (:translate (setf fdefn-fun)) (:args (function :scs (descriptor-reg) :target result) - (fdefn :scs (descriptor-reg))) + (fdefn :scs (descriptor-reg))) (:temporary (:scs (interior-reg)) lip) (:temporary (:scs (non-descriptor-reg)) type) (:results (result :scs (descriptor-reg))) @@ -112,7 +134,7 @@ (inst cmp type simple-fun-header-widetag) (inst b :eq normal-fn) (inst move lip function) - (inst li lip (make-fixup (extern-alien-name "closure_tramp") :foreign)) + (inst li lip (make-fixup "closure_tramp" :foreign)) (emit-label normal-fn) (storew function fdefn fdefn-fun-slot other-pointer-lowtag) (storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag) @@ -126,7 +148,7 @@ (:results (result :scs (descriptor-reg))) (:generator 38 (storew null-tn fdefn fdefn-fun-slot other-pointer-lowtag) - (inst li temp (make-fixup (extern-alien-name "undefined_tramp") :foreign)) + (inst li temp (make-fixup "undefined_tramp" :foreign)) (storew temp fdefn fdefn-raw-addr-slot other-pointer-lowtag) (move result fdefn))) @@ -139,7 +161,7 @@ ;;; symbol. (define-vop (bind) (:args (val :scs (any-reg descriptor-reg)) - (symbol :scs (descriptor-reg))) + (symbol :scs (descriptor-reg))) (:temporary (:scs (descriptor-reg)) temp) (:generator 5 (loadw temp symbol symbol-value-slot other-pointer-lowtag) @@ -155,6 +177,7 @@ (loadw value bsp-tn (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (inst sub bsp-tn bsp-tn (* 2 n-word-bytes)))) (define-vop (unbind-to-here) @@ -163,8 +186,8 @@ (:temporary (:scs (descriptor-reg)) symbol value) (:generator 0 (let ((loop (gen-label)) - (skip (gen-label)) - (done (gen-label))) + (skip (gen-label)) + (done (gen-label))) (move where arg) (inst cmp where bsp-tn) (inst b :eq done) @@ -179,6 +202,7 @@ (storew zero-tn bsp-tn (- binding-symbol-slot binding-size)) (emit-label skip) + (storew zero-tn bsp-tn (- binding-value-slot binding-size)) (inst sub bsp-tn bsp-tn (* 2 n-word-bytes)) (inst cmp where bsp-tn) (inst b :ne loop) @@ -200,15 +224,17 @@ (:variant funcallable-instance-info-offset fun-pointer-lowtag) (:translate %set-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. @@ -231,33 +257,14 @@ (loadw temp struct 0 instance-pointer-lowtag) (inst srl res temp n-widetag-bits))) -(define-vop (instance-ref slot-ref) - (:variant instance-slots-offset instance-pointer-lowtag) - (:policy :fast-safe) - (:translate %instance-ref) - (:arg-types * (:constant index))) - -;;; This VOP has no :results; however, %instance-set must return a -;;; value. This caused, in the forward port to 0.7.x, an error in -;;; !fdefn-cold-init: "argument X is not a REAL: NIL". This VOP is -;;; commented out for now, pending the addition of checking code to -;;; the define-vop machinery to ascertain that this was indeed the -;;; problem. -- CSR, 2002-02-12 -#+nil -(define-vop (instance-set slot-set) - (:policy :fast-safe) - (:translate %instance-set) - (:variant instance-slots-offset instance-pointer-lowtag) - (:arg-types * (:constant index) *)) - (define-vop (instance-index-ref word-index-ref) - (:policy :fast-safe) + (:policy :fast-safe) (:translate %instance-ref) (:variant instance-slots-offset instance-pointer-lowtag) (:arg-types * positive-fixnum)) (define-vop (instance-index-set word-index-set) - (:policy :fast-safe) + (:policy :fast-safe) (:translate %instance-set) (:variant instance-slots-offset instance-pointer-lowtag) (:arg-types * positive-fixnum *)) @@ -274,3 +281,250 @@ (:policy :fast-safe) (:variant 0 other-pointer-lowtag)) + + +;;;; raw instance slot accessors + +(define-vop (raw-instance-ref/word) + (:translate %raw-instance-ref/word) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (unsigned-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:result-types unsigned-num) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset offset n-widetag-bits) + (inst sll offset offset n-fixnum-tag-bits) + (inst sub offset offset index) + (inst add + offset + offset + (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst ld value object offset))) + +(define-vop (raw-instance-set/word) + (:translate %raw-instance-set/word) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (unsigned-reg))) + (:arg-types * positive-fixnum unsigned-num) + (:results (result :scs (unsigned-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:result-types unsigned-num) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset offset n-widetag-bits) + (inst sll offset offset n-fixnum-tag-bits) + (inst sub offset offset index) + (inst add + offset + offset + (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst st value object offset) + (move result value))) + +(define-vop (raw-instance-ref/single) + (:translate %raw-instance-ref/single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (single-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:result-types single-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset offset n-widetag-bits) + (inst sll offset offset n-fixnum-tag-bits) + (inst sub offset offset index) + (inst add + offset + offset + (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst ldf value object offset))) + +(define-vop (raw-instance-set/single) + (:translate %raw-instance-set/single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (single-reg) :target result)) + (:arg-types * positive-fixnum single-float) + (:results (result :scs (single-reg))) + (:result-types single-float) + (:temporary (:scs (non-descriptor-reg)) offset) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset offset n-widetag-bits) + (inst sll offset offset n-fixnum-tag-bits) + (inst sub offset offset index) + (inst add + offset + offset + (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst stf value object offset) + (unless (location= result value) + (inst fmovs result value)))) + +(define-vop (raw-instance-ref/double) + (:translate %raw-instance-ref/double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (double-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:result-types double-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset offset n-widetag-bits) + (inst sll offset offset n-fixnum-tag-bits) + (inst sub offset offset index) + (inst add + offset + offset + (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (inst lddf value object offset))) + +(define-vop (raw-instance-set/double) + (:translate %raw-instance-set/double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (double-reg) :target result)) + (:arg-types * positive-fixnum double-float) + (:results (result :scs (double-reg))) + (:result-types double-float) + (:temporary (:scs (non-descriptor-reg)) offset) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset offset n-widetag-bits) + (inst sll offset offset n-fixnum-tag-bits) + (inst sub offset offset index) + (inst add + offset + offset + (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (inst stdf value object offset) + (unless (location= result value) + (move-double-reg result value)))) + +(define-vop (raw-instance-ref/complex-single) + (:translate %raw-instance-ref/complex-single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (complex-single-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:result-types complex-single-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset offset n-widetag-bits) + (inst sll offset offset n-fixnum-tag-bits) + (inst sub offset offset index) + (inst add + offset + offset + (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (inst ldf (complex-single-reg-real-tn value) object offset) + (inst add offset offset n-word-bytes) + (inst ldf (complex-single-reg-imag-tn value) object offset))) + +(define-vop (raw-instance-set/complex-single) + (:translate %raw-instance-set/complex-single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (complex-single-reg) :target result)) + (:arg-types * positive-fixnum complex-single-float) + (:results (result :scs (complex-single-reg))) + (:result-types complex-single-float) + (:temporary (:scs (non-descriptor-reg)) offset) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset offset n-widetag-bits) + (inst sll offset offset n-fixnum-tag-bits) + (inst sub offset offset index) + (inst add + offset + offset + (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (let ((value-real (complex-single-reg-real-tn value)) + (result-real (complex-single-reg-real-tn result))) + (inst stf value-real object offset) + (unless (location= result-real value-real) + (inst fmovs result-real value-real))) + (inst add offset offset n-word-bytes) + (let ((value-imag (complex-single-reg-imag-tn value)) + (result-imag (complex-single-reg-imag-tn result))) + (inst stf value-imag object offset) + (unless (location= result-imag value-imag) + (inst fmovs result-imag value-imag))))) + +(define-vop (raw-instance-ref/complex-double) + (:translate %raw-instance-ref/complex-double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (complex-double-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:result-types complex-double-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset offset n-widetag-bits) + (inst sll offset offset n-fixnum-tag-bits) + (inst sub offset offset index) + (inst add + offset + offset + (- (* (- instance-slots-offset 4) n-word-bytes) + instance-pointer-lowtag)) + (inst lddf (complex-double-reg-real-tn value) object offset) + (inst add offset offset (* 2 n-word-bytes)) + (inst lddf (complex-double-reg-imag-tn value) object offset))) + +(define-vop (raw-instance-set/complex-double) + (:translate %raw-instance-set/complex-double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (complex-double-reg) :target result)) + (:arg-types * positive-fixnum complex-double-float) + (:results (result :scs (complex-double-reg))) + (:result-types complex-double-float) + (:temporary (:scs (non-descriptor-reg)) offset) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset offset n-widetag-bits) + (inst sll offset offset n-fixnum-tag-bits) + (inst sub offset offset index) + (inst add + offset + offset + (- (* (- instance-slots-offset 4) n-word-bytes) + instance-pointer-lowtag)) + (let ((value-real (complex-double-reg-real-tn value)) + (result-real (complex-double-reg-real-tn result))) + (inst stdf value-real object offset) + (unless (location= result-real value-real) + (move-double-reg result-real value-real))) + (inst add offset offset (* 2 n-word-bytes)) + (let ((value-imag (complex-double-reg-imag-tn value)) + (result-imag (complex-double-reg-imag-tn result))) + (inst stdf value-imag object offset) + (unless (location= result-imag value-imag) + (move-double-reg result-imag value-imag)))))