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