X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fppc%2Fcell.lisp;h=8ac94b3f62c2810f9966785f3c2d21161f77fc7b;hb=74cfbf6d0572b7df1b3492563408a7cb3ae103cf;hp=8dccc05fbe98707a7e1d21b518d92f157d9557e5;hpb=03fdcf4cd8f7551759c64c83144c11f423f4e6b6;p=sbcl.git diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp index 8dccc05..8ac94b3 100644 --- a/src/compiler/ppc/cell.lisp +++ b/src/compiler/ppc/cell.lisp @@ -54,7 +54,7 @@ (:generator 9 (move obj-temp object) (loadw value obj-temp symbol-value-slot other-pointer-lowtag) - (let ((err-lab (generate-error-code vop unbound-symbol-error obj-temp))) + (let ((err-lab (generate-error-code vop 'unbound-symbol-error obj-temp))) (inst cmpwi value unbound-marker-widetag) (inst beq err-lab)))) @@ -92,6 +92,13 @@ ;; ensure this is explained in the comment in objdef.lisp (loadw res symbol symbol-hash-slot other-pointer-lowtag) (inst clrrwi res res 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. @@ -108,7 +115,7 @@ (move obj-temp object) (loadw value obj-temp fdefn-fun-slot other-pointer-lowtag) (inst cmpw value null-tn) - (let ((err-lab (generate-error-code vop undefined-fun-error obj-temp))) + (let ((err-lab (generate-error-code vop 'undefined-fun-error obj-temp))) (inst beq err-lab)))) (define-vop (set-fdefn-fun) @@ -172,6 +179,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 subi bsp-tn bsp-tn (* 2 n-word-bytes)))) @@ -196,6 +204,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 subi bsp-tn bsp-tn (* 2 n-word-bytes)) (inst cmpw where bsp-tn) (inst bne loop) @@ -218,10 +227,6 @@ (: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)) @@ -252,19 +257,6 @@ (loadw temp struct 0 instance-pointer-lowtag) (inst srwi 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))) - -#+nil -(define-vop (instance-set slot-set) - (:policy :fast-safe) - (:translate %instance-set) - (:variant instance-slots-offset instance-pointer-lowtag) - (:arg-types instance (:constant index) *)) - (define-vop (instance-index-ref word-index-ref) (:policy :fast-safe) (:translate %instance-ref) @@ -296,6 +288,19 @@ ;;;; raw instance slot accessors +(defun offset-for-raw-slot (instance-length index n-words) + (+ (* (- instance-length instance-slots-offset index (1- n-words)) + n-word-bytes) + (- instance-pointer-lowtag))) + +(define-vop (raw-instance-init/word) + (:args (object :scs (descriptor-reg)) + (value :scs (unsigned-reg))) + (:arg-types * unsigned-num) + (:info instance-length index) + (:generator 4 + (inst stw value object (offset-for-raw-slot instance-length index 1)))) + (define-vop (raw-instance-ref/word) (:translate %raw-instance-ref/word) (:policy :fast-safe) @@ -340,6 +345,14 @@ (inst stwx value object offset) (move result value))) +(define-vop (raw-instance-init/single) + (:args (object :scs (descriptor-reg)) + (value :scs (single-reg))) + (:arg-types * single-float) + (:info instance-length index) + (:generator 4 + (inst stfs value object (offset-for-raw-slot instance-length index 1)))) + (define-vop (raw-instance-ref/single) (:translate %raw-instance-ref/single) (:policy :fast-safe) @@ -385,6 +398,14 @@ (unless (location= result value) (inst frsp result value)))) +(define-vop (raw-instance-init/double) + (:args (object :scs (descriptor-reg)) + (value :scs (double-reg))) + (:arg-types * double-float) + (:info instance-length index) + (:generator 4 + (inst stfd value object (offset-for-raw-slot instance-length index 2)))) + (define-vop (raw-instance-ref/double) (:translate %raw-instance-ref/double) (:policy :fast-safe) @@ -430,6 +451,17 @@ (unless (location= result value) (inst fmr result value)))) +(define-vop (raw-instance-init/complex-single) + (:args (object :scs (descriptor-reg)) + (value :scs (complex-single-reg))) + (:arg-types * complex-single-float) + (:info instance-length index) + (:generator 4 + (inst stfs (complex-single-reg-real-tn value) + object (offset-for-raw-slot instance-length index 2)) + (inst stfs (complex-single-reg-imag-tn value) + object (offset-for-raw-slot instance-length index 1)))) + (define-vop (raw-instance-ref/complex-single) (:translate %raw-instance-ref/complex-single) (:policy :fast-safe) @@ -485,6 +517,17 @@ (unless (location= result-imag value-imag) (inst frsp result-imag value-imag))))) +(define-vop (raw-instance-init/complex-double) + (:args (object :scs (descriptor-reg)) + (value :scs (complex-double-reg))) + (:arg-types * complex-double-float) + (:info instance-length index) + (:generator 4 + (inst stfd (complex-single-reg-real-tn value) + object (offset-for-raw-slot instance-length index 4)) + (inst stfd (complex-double-reg-imag-tn value) + object (offset-for-raw-slot instance-length index 2)))) + (define-vop (raw-instance-ref/complex-double) (:translate %raw-instance-ref/complex-double) (:policy :fast-safe)