X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fcell.lisp;h=70af45722e70581ec829ea526d50f3695545a8da;hb=51344a3364f2cd6b14985719a77f697c094ea14d;hp=3d5fb374d5cb2034fadbe878984ac8fd6b1da50a;hpb=cab2c71bb1bb8a575d9eebdae335e731daa64183;p=sbcl.git diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp index 3d5fb37..70af457 100644 --- a/src/compiler/ppc/cell.lisp +++ b/src/compiler/ppc/cell.lisp @@ -1,12 +1,16 @@ -;;; VOPs for the PPC. -;;; -;;; Written by Rob MacLachlan -;;; -;;; Converted by William Lott. -;;; +;;;; the VM definition of various primitive memory access VOPs for the +;;;; PPC + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. (in-package "SB!VM") - ;;;; Data object ref/set stuff. @@ -20,24 +24,21 @@ (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))) - ;;;; Symbol hacking VOPs: ;;; The compiler likes to be able to directly SET symbols. -;;; (define-vop (set cell-set) (:variant symbol-value-slot other-pointer-lowtag)) ;;; Do a cell ref with an error check for being unbound. -;;; (define-vop (checked-cell-ref) (:args (object :scs (descriptor-reg) :target obj-temp)) (:results (value :scs (descriptor-reg any-reg))) @@ -46,19 +47,19 @@ (:save-p :compute-only) (:temporary (:scs (descriptor-reg) :from (:argument 0)) obj-temp)) -;;; With Symbol-Value, we check that the value isn't the trap object. So -;;; Symbol-Value of NIL is NIL. -;;; +;;; With SYMBOL-VALUE, we check that the value isn't the trap object. +;;; So SYMBOL-VALUE of NIL is NIL. (define-vop (symbol-value checked-cell-ref) (:translate symbol-value) (:generator 9 (move obj-temp object) - (loadw value obj-temp sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) + (loadw value obj-temp symbol-value-slot other-pointer-lowtag) (let ((err-lab (generate-error-code vop unbound-symbol-error obj-temp))) - (inst cmpwi value sb!vm:unbound-marker-widetag) + (inst cmpwi value unbound-marker-widetag) (inst beq err-lab)))) -;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell is bound. +;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell +;;; is bound. (define-vop (boundp-frob) (:args (object :scs (descriptor-reg))) (:conditional) @@ -69,15 +70,28 @@ (define-vop (boundp boundp-frob) (:translate boundp) (:generator 9 - (loadw value object sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) - (inst cmpwi value sb!vm:unbound-marker-widetag) + (loadw value object symbol-value-slot other-pointer-lowtag) + (inst cmpwi value unbound-marker-widetag) (inst b? (if not-p :eq :ne) target))) (define-vop (fast-symbol-value cell-ref) - (:variant sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) + (:variant symbol-value-slot other-pointer-lowtag) (: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 clrrwi res res n-fixnum-tag-bits))) ;;;; Fdefinition (fdefn) objects. @@ -101,7 +115,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))) @@ -111,7 +125,7 @@ (inst cmpwi type simple-fun-header-widetag) ;;(inst mr lip function) (inst addi lip function - (- (ash simple-fun-code-offset word-shift) fun-pointer-lowtag)) + (- (ash simple-fun-code-offset word-shift) fun-pointer-lowtag)) (inst beq normal-fn) (inst lr lip (make-fixup "closure_tramp" :foreign)) (emit-label normal-fn) @@ -141,24 +155,25 @@ (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 sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) - (inst addi bsp-tn bsp-tn (* 2 sb!vm:n-word-bytes)) - (storew temp bsp-tn (- sb!vm:binding-value-slot sb!vm:binding-size)) - (storew symbol bsp-tn (- sb!vm:binding-symbol-slot sb!vm:binding-size)) - (storew val symbol sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag))) + (loadw temp symbol symbol-value-slot other-pointer-lowtag) + (inst addi bsp-tn bsp-tn (* 2 n-word-bytes)) + (storew temp bsp-tn (- binding-value-slot binding-size)) + (storew symbol bsp-tn (- binding-symbol-slot binding-size)) + (storew val symbol symbol-value-slot other-pointer-lowtag))) (define-vop (unbind) (:temporary (:scs (descriptor-reg)) symbol value) (:generator 0 - (loadw symbol bsp-tn (- sb!vm:binding-symbol-slot sb!vm:binding-size)) - (loadw value bsp-tn (- sb!vm:binding-value-slot sb!vm:binding-size)) - (storew value symbol sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) - (storew zero-tn bsp-tn (- sb!vm:binding-symbol-slot sb!vm:binding-size)) - (inst subi bsp-tn bsp-tn (* 2 sb!vm:n-word-bytes)))) + (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)) + (inst subi bsp-tn bsp-tn (* 2 n-word-bytes)))) (define-vop (unbind-to-here) @@ -167,22 +182,23 @@ (: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 cmpw where bsp-tn) (inst beq done) (emit-label loop) - (loadw symbol bsp-tn (- sb!vm:binding-symbol-slot sb!vm:binding-size)) + (loadw symbol bsp-tn (- binding-symbol-slot binding-size)) (inst cmpwi symbol 0) (inst beq skip) - (loadw value bsp-tn (- sb!vm:binding-value-slot sb!vm:binding-size)) - (storew value symbol sb!vm:symbol-value-slot sb!vm:other-pointer-lowtag) - (storew zero-tn bsp-tn (- sb!vm:binding-symbol-slot sb!vm: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)) (emit-label skip) - (inst subi bsp-tn bsp-tn (* 2 sb!vm:n-word-bytes)) + (inst subi bsp-tn bsp-tn (* 2 n-word-bytes)) (inst cmpw where bsp-tn) (inst bne loop) @@ -193,11 +209,11 @@ ;;;; Closure indexing. (define-vop (closure-index-ref word-index-ref) - (:variant sb!vm:closure-info-offset sb!vm:fun-pointer-lowtag) + (:variant closure-info-offset fun-pointer-lowtag) (:translate %closure-index-ref)) (define-vop (funcallable-instance-info word-index-ref) - (:variant funcallable-instance-info-offset sb!vm:fun-pointer-lowtag) + (:variant funcallable-instance-info-offset fun-pointer-lowtag) (:translate %funcallable-instance-info)) (define-vop (set-funcallable-instance-info word-index-set) @@ -236,7 +252,7 @@ (:result-types positive-fixnum) (:generator 4 (loadw temp struct 0 instance-pointer-lowtag) - (inst srwi res temp sb!vm:n-widetag-bits))) + (inst srwi res temp n-widetag-bits))) (define-vop (instance-ref slot-ref) (:variant instance-slots-offset instance-pointer-lowtag) @@ -252,13 +268,13 @@ (:arg-types instance (: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 instance 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 instance positive-fixnum *)) @@ -278,3 +294,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) + ;; offset = (offset >> n-widetag-bits) << 2 + (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29) + (inst subf offset index offset) + (inst addi + offset + offset + (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst lwzx 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) + ;; offset = (offset >> n-widetag-bits) << 2 + (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29) + (inst subf offset index offset) + (inst addi + offset + offset + (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst stwx 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) + ;; offset = (offset >> n-widetag-bits) << 2 + (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29) + (inst subf offset index offset) + (inst addi + offset + offset + (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst lfsx 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) + ;; offset = (offset >> n-widetag-bits) << 2 + (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29) + (inst subf offset index offset) + (inst addi + offset + offset + (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst stfsx value object offset) + (unless (location= result value) + (inst frsp 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) + ;; offset = (offset >> n-widetag-bits) << 2 + (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29) + (inst subf offset index offset) + (inst addi + offset + offset + (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (inst lfdx 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) + ;; offset = (offset >> n-widetag-bits) << 2 + (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29) + (inst subf offset index offset) + (inst addi + offset + offset + (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (inst stfdx value object offset) + (unless (location= result value) + (inst fmr 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) + ;; offset = (offset >> n-widetag-bits) << 2 + (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29) + (inst subf offset index offset) + (inst addi + offset + offset + (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (inst lfsx (complex-single-reg-real-tn value) object offset) + (inst addi offset offset n-word-bytes) + (inst lfsx (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) + ;; offset = (offset >> n-widetag-bits) << 2 + (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29) + (inst subf offset index offset) + (inst addi + 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 stfsx value-real object offset) + (unless (location= result-real value-real) + (inst frsp result-real value-real))) + (inst addi offset offset n-word-bytes) + (let ((value-imag (complex-single-reg-imag-tn value)) + (result-imag (complex-single-reg-imag-tn result))) + (inst stfsx value-imag object offset) + (unless (location= result-imag value-imag) + (inst frsp 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) + ;; offset = (offset >> n-widetag-bits) << 2 + (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29) + (inst subf offset index offset) + (inst addi + offset + offset + (- (* (- instance-slots-offset 4) n-word-bytes) + instance-pointer-lowtag)) + (inst lfdx (complex-double-reg-real-tn value) object offset) + (inst addi offset offset (* 2 n-word-bytes)) + (inst lfdx (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) + ;; offset = (offset >> n-widetag-bits) << 2 + (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29) + (inst subf offset index offset) + (inst addi + 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 stfdx value-real object offset) + (unless (location= result-real value-real) + (inst fmr result-real value-real))) + (inst addi offset offset (* 2 n-word-bytes)) + (let ((value-imag (complex-double-reg-imag-tn value)) + (result-imag (complex-double-reg-imag-tn result))) + (inst stfdx value-imag object offset) + (unless (location= result-imag value-imag) + (inst fmr result-imag value-imag)))))