src/compiler/mips/cell.lisp

   1 (in-package "SB!VM")
   2
   3 \f
   4 ;;;; Data object ref/set stuff.
   5
   6 (define-vop (slot)
   7   (:args (object :scs (descriptor-reg)))
   8   (:info name offset lowtag)
   9   (:ignore name)
  10   (:results (result :scs (descriptor-reg any-reg)))
  11   (:generator 1
  12     (loadw result object offset lowtag)))
  13
  14 (define-vop (set-slot)
  15   (:args (object :scs (descriptor-reg))
  16          (value :scs (descriptor-reg any-reg null zero)))
  17   (:info name offset lowtag)
  18   (:ignore name)
  19   (:results)
  20   (:generator 1
  21     (storew value object offset lowtag)))
  22
  23 \f
  24 ;;;; Symbol hacking VOPs:
  25
  26 ;;; The compiler likes to be able to directly SET symbols.
  27 ;;;
  28 (define-vop (set cell-set)
  29   (:variant symbol-value-slot other-pointer-lowtag))
  30
  31 ;;; Do a cell ref with an error check for being unbound.
  32 ;;;
  33 (define-vop (checked-cell-ref)
  34   (:args (object :scs (descriptor-reg) :target obj-temp))
  35   (:results (value :scs (descriptor-reg any-reg)))
  36   (:policy :fast-safe)
  37   (:vop-var vop)
  38   (:save-p :compute-only)
  39   (:temporary (:scs (non-descriptor-reg)) temp)
  40   (:temporary (:scs (descriptor-reg) :from (:argument 0)) obj-temp))
  41
  42 ;;; With Symbol-Value, we check that the value isn't the trap object.  So
  43 ;;; Symbol-Value of NIL is NIL.
  44 ;;;
  45 (define-vop (symbol-value checked-cell-ref)
  46   (:translate symbol-value)
  47   (:generator 9
  48     (move obj-temp object)
  49     (loadw value obj-temp symbol-value-slot other-pointer-lowtag)
  50     (let ((err-lab (generate-error-code vop unbound-symbol-error obj-temp)))
  51       (inst xor temp value unbound-marker-widetag)
  52       (inst beq temp zero-tn err-lab)
  53       (inst nop))))
  54
  55 ;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell is bound.
  56 (define-vop (boundp-frob)
  57   (:args (object :scs (descriptor-reg)))
  58   (:conditional)
  59   (:info target not-p)
  60   (:policy :fast-safe)
  61   (:temporary (:scs (descriptor-reg)) value)
  62   (:temporary (:scs (non-descriptor-reg)) temp))
  63
  64 (define-vop (boundp boundp-frob)
  65   (:translate boundp)
  66   (:generator 9
  67     (loadw value object symbol-value-slot other-pointer-lowtag)
  68     (inst xor temp value unbound-marker-widetag)
  69     (if not-p
  70         (inst beq temp zero-tn target)
  71         (inst bne temp zero-tn target))
  72     (inst nop)))
  73
  74 (define-vop (fast-symbol-value cell-ref)
  75   (:variant symbol-value-slot other-pointer-lowtag)
  76   (:policy :fast)
  77   (:translate symbol-value))
  78
  79 \f
  80 ;;;; Fdefinition (fdefn) objects.
  81
  82 (define-vop (fdefn-fun cell-ref)
  83   (:variant fdefn-fun-slot other-pointer-lowtag))
  84
  85 (define-vop (safe-fdefn-fun)
  86   (:args (object :scs (descriptor-reg) :target obj-temp))
  87   (:results (value :scs (descriptor-reg any-reg)))
  88   (:vop-var vop)
  89   (:save-p :compute-only)
  90   (:temporary (:scs (descriptor-reg) :from (:argument 0)) obj-temp)
  91   (:generator 10
  92     (move obj-temp object)
  93     (loadw value obj-temp fdefn-fun-slot other-pointer-lowtag)
  94     (let ((err-lab (generate-error-code vop undefined-fun-error obj-temp)))
  95       (inst beq value null-tn err-lab))
  96     (inst nop)))
  97
  98 (define-vop (set-fdefn-fun)
  99   (:policy :fast-safe)
 100   (:translate (setf fdefn-fun))
 101   (:args (function :scs (descriptor-reg) :target result)
 102          (fdefn :scs (descriptor-reg)))
 103   (:temporary (:scs (interior-reg)) lip)
 104   (:temporary (:scs (non-descriptor-reg)) type)
 105   (:results (result :scs (descriptor-reg)))
 106   (:generator 38
 107     (let ((normal-fn (gen-label)))
 108       (load-type type function (- fun-pointer-lowtag))
 109       (inst nop)
 110       (inst xor type simple-fun-header-widetag)
 111       (inst beq type zero-tn normal-fn)
 112       (inst addu lip function
 113             (- (ash simple-fun-code-offset word-shift)
 114                fun-pointer-lowtag))
 115       (inst li lip (make-fixup "closure_tramp" :foreign))
 116       (emit-label normal-fn)
 117       (storew lip fdefn fdefn-raw-addr-slot other-pointer-lowtag)
 118       (storew function fdefn fdefn-fun-slot other-pointer-lowtag)
 119       (move result function))))
 120
 121 (define-vop (fdefn-makunbound)
 122   (:policy :fast-safe)
 123   (:translate fdefn-makunbound)
 124   (:args (fdefn :scs (descriptor-reg) :target result))
 125   (:temporary (:scs (non-descriptor-reg)) temp)
 126   (:results (result :scs (descriptor-reg)))
 127   (:generator 38
 128     (storew null-tn fdefn fdefn-fun-slot other-pointer-lowtag)
 129     (inst li temp (make-fixup "undefined_tramp" :foreign))
 130     (storew temp fdefn fdefn-raw-addr-slot other-pointer-lowtag)
 131     (move result fdefn)))
 132
 133
 134 \f
 135 ;;;; Binding and Unbinding.
 136
 137 ;;; BIND -- Establish VAL as a binding for SYMBOL.  Save the old value and
 138 ;;; the symbol on the binding stack and stuff the new value into the
 139 ;;; symbol.
 140
 141 (define-vop (bind)
 142   (:args (val :scs (any-reg descriptor-reg))
 143          (symbol :scs (descriptor-reg)))
 144   (:temporary (:scs (descriptor-reg)) temp)
 145   (:generator 5
 146     (loadw temp symbol symbol-value-slot other-pointer-lowtag)
 147     (inst addu bsp-tn bsp-tn (* 2 n-word-bytes))
 148     (storew temp bsp-tn (- binding-value-slot binding-size))
 149     (storew symbol bsp-tn (- binding-symbol-slot binding-size))
 150     (storew val symbol symbol-value-slot other-pointer-lowtag)))
 151
 152
 153 (define-vop (unbind)
 154   (:temporary (:scs (descriptor-reg)) symbol value)
 155   (:generator 0
 156     (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
 157     (loadw value bsp-tn (- binding-value-slot binding-size))
 158     (storew value symbol symbol-value-slot other-pointer-lowtag)
 159     (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
 160     (inst addu bsp-tn bsp-tn (* -2 n-word-bytes))))
 161
 162
 163 (define-vop (unbind-to-here)
 164   (:args (arg :scs (descriptor-reg any-reg) :target where))
 165   (:temporary (:scs (any-reg) :from (:argument 0)) where)
 166   (:temporary (:scs (descriptor-reg)) symbol value)
 167   (:generator 0
 168     (let ((loop (gen-label))
 169           (skip (gen-label))
 170           (done (gen-label)))
 171       (move where arg)
 172       (inst beq where bsp-tn done)
 173       (inst nop)
 174
 175       (emit-label loop)
 176       (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
 177       (inst beq symbol zero-tn skip)
 178       (loadw value bsp-tn (- binding-value-slot binding-size))
 179       (storew value symbol symbol-value-slot other-pointer-lowtag)
 180       (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
 181
 182       (emit-label skip)
 183       (inst addu bsp-tn bsp-tn (* -2 n-word-bytes))
 184       (inst bne where bsp-tn loop)
 185       (inst nop)
 186
 187       (emit-label done))))
 188
 189
 190 \f
 191 ;;;; Closure indexing.
 192
 193 (define-full-reffer closure-index-ref *
 194   closure-info-offset fun-pointer-lowtag
 195   (descriptor-reg any-reg) * %closure-index-ref)
 196
 197 (define-full-setter set-funcallable-instance-info *
 198   funcallable-instance-info-offset fun-pointer-lowtag
 199   (descriptor-reg any-reg null zero) * %set-funcallable-instance-info)
 200
 201 (define-full-reffer funcallable-instance-info *
 202   funcallable-instance-info-offset fun-pointer-lowtag
 203   (descriptor-reg any-reg) * %funcallable-instance-info)
 204
 205 (define-vop (funcallable-instance-lexenv cell-ref)
 206   (:variant funcallable-instance-lexenv-slot fun-pointer-lowtag))
 207
 208 (define-vop (closure-ref slot-ref)
 209   (:variant closure-info-offset fun-pointer-lowtag))
 210
 211 (define-vop (closure-init slot-set)
 212   (:variant closure-info-offset fun-pointer-lowtag))
 213
 214 \f
 215 ;;;; Value Cell hackery.
 216
 217 (define-vop (value-cell-ref cell-ref)
 218   (:variant value-cell-value-slot other-pointer-lowtag))
 219
 220 (define-vop (value-cell-set cell-set)
 221   (:variant value-cell-value-slot other-pointer-lowtag))
 222
 223
 224 \f
 225 ;;;; Instance hackery:
 226
 227 (define-vop (instance-length)
 228   (:policy :fast-safe)
 229   (:translate %instance-length)
 230   (:args (struct :scs (descriptor-reg)))
 231   (:results (res :scs (unsigned-reg)))
 232   (:result-types positive-fixnum)
 233   (:generator 4
 234     (loadw res struct 0 instance-pointer-lowtag)
 235     (inst srl res n-widetag-bits)))
 236
 237 (define-vop (instance-ref slot-ref)
 238   (:variant instance-slots-offset instance-pointer-lowtag)
 239   (:policy :fast-safe)
 240   (:translate %instance-ref)
 241   (:arg-types instance (:constant index)))
 242
 243 #+nil
 244 (define-vop (instance-set slot-set)
 245   (:policy :fast-safe)
 246   (:translate %instance-set)
 247   (:variant instance-slots-offset instance-pointer-lowtag)
 248   (:arg-types instance (:constant index) *))
 249
 250 (define-full-reffer instance-index-ref * instance-slots-offset
 251   instance-pointer-lowtag (descriptor-reg any-reg) * %instance-ref)
 252
 253 (define-full-setter instance-index-set * instance-slots-offset
 254   instance-pointer-lowtag (descriptor-reg any-reg null zero) * %instance-set)
 255
 256
 257 \f
 258 ;;;; Code object frobbing.
 259
 260 (define-full-reffer code-header-ref * 0 other-pointer-lowtag
 261   (descriptor-reg any-reg) * code-header-ref)
 262
 263 (define-full-setter code-header-set * 0 other-pointer-lowtag
 264   (descriptor-reg any-reg null zero) * code-header-set)
 265
 266
 267