src/compiler/ppc/memory.lisp

   1 ;;; reference VOPs inherited by basic memory reference operations.
   2 ;;;
   3 ;;; Written by Rob MacLachlan
   4 ;;;
   5 ;;; Converted by William Lott.
   6 ;;;
   7
   8 (in-package "SB!VM")
   9
  10 ;;; Cell-Ref and Cell-Set are used to define VOPs like CAR, where the offset to
  11 ;;; be read or written is a property of the VOP used.
  12 ;;;
  13 (define-vop (cell-ref)
  14   (:args (object :scs (descriptor-reg)))
  15   (:results (value :scs (descriptor-reg any-reg)))
  16   (:variant-vars offset lowtag)
  17   (:policy :fast-safe)
  18   (:generator 4
  19     (loadw value object offset lowtag)))
  20 ;;;
  21 (define-vop (cell-set)
  22   (:args (object :scs (descriptor-reg))
  23          (value :scs (descriptor-reg any-reg)))
  24   (:variant-vars offset lowtag)
  25   (:policy :fast-safe)
  26   (:generator 4
  27     (storew value object offset lowtag)))
  28
  29 ;;; Slot-Ref and Slot-Set are used to define VOPs like Closure-Ref, where the
  30 ;;; offset is constant at compile time, but varies for different uses.  We add
  31 ;;; in the standard g-vector overhead.
  32 ;;;
  33 (define-vop (slot-ref)
  34   (:args (object :scs (descriptor-reg)))
  35   (:results (value :scs (descriptor-reg any-reg)))
  36   (:variant-vars base lowtag)
  37   (:info offset)
  38   (:generator 4
  39     (loadw value object (+ base offset) lowtag)))
  40 ;;;
  41 (define-vop (slot-set)
  42   (:args (object :scs (descriptor-reg))
  43          (value :scs (descriptor-reg any-reg)))
  44   (:variant-vars base lowtag)
  45   (:info offset)
  46   (:generator 4
  47     (storew value object (+ base offset) lowtag)))
  48
  49
  50 \f
  51 ;;;; Indexed references:
  52
  53 ;;; Define some VOPs for indexed memory reference.
  54 (defmacro define-indexer (name write-p ri-op rr-op shift &optional sign-extend-byte)
  55   `(define-vop (,name)
  56      (:args (object :scs (descriptor-reg))
  57             (index :scs (any-reg zero immediate))
  58             ,@(when write-p
  59                 '((value :scs (any-reg descriptor-reg) :target result))))
  60      (:arg-types * tagged-num ,@(when write-p '(*)))
  61      (:temporary (:scs (non-descriptor-reg)) temp)
  62      (:results (,(if write-p 'result 'value)
  63                 :scs (any-reg descriptor-reg)))
  64      (:result-types *)
  65      (:variant-vars offset lowtag)
  66      (:policy :fast-safe)
  67      (:generator 5
  68        (sc-case index
  69          ((immediate zero)
  70           (let ((offset (- (+ (if (sc-is index zero)
  71                                   0
  72                                   (ash (tn-value index)
  73                                        (- sb!vm:word-shift ,shift)))
  74                               (ash offset sb!vm:word-shift))
  75                            lowtag)))
  76             (etypecase offset
  77               ((signed-byte 16)
  78                (inst ,ri-op value object offset))
  79               ((or (unsigned-byte 32) (signed-byte 32))
  80                (inst lr temp offset)
  81                (inst ,rr-op value object temp)))))
  82          (t
  83           ,@(unless (zerop shift)
  84               `((inst srwi temp index ,shift)))
  85           (inst addi temp ,(if (zerop shift) 'index 'temp)
  86                 (- (ash offset sb!vm:word-shift) lowtag))
  87           (inst ,rr-op value object temp)))
  88        ,@(when sign-extend-byte
  89            `((inst extsb value value)))
  90        ,@(when write-p
  91            '((move result value))))))
  92
  93 (define-indexer word-index-ref nil lwz lwzx 0)
  94 (define-indexer word-index-set t stw stwx 0)
  95 (define-indexer halfword-index-ref nil lhz lhzx 1)
  96 (define-indexer signed-halfword-index-ref nil lha lhax 1)
  97 (define-indexer halfword-index-set t sth sthx 1)
  98 (define-indexer byte-index-ref nil lbz lbzx 2)
  99 (define-indexer signed-byte-index-ref nil lbz lbzx 2 t)
 100 (define-indexer byte-index-set t stb stbx 2)
 101