src/compiler/ppc/memory.lisp

   1 ;;;; the PPC definitions of some general purpose memory reference VOPs
   2 ;;;; inherited by basic memory reference operations
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!VM")
  14 \f
  15 ;;; Cell-Ref and Cell-Set are used to define VOPs like CAR, where the offset to
  16 ;;; be read or written is a property of the VOP used.
  17 ;;;
  18 (define-vop (cell-ref)
  19   (:args (object :scs (descriptor-reg)))
  20   (:results (value :scs (descriptor-reg any-reg)))
  21   (:variant-vars offset lowtag)
  22   (:policy :fast-safe)
  23   (:generator 4
  24     (loadw value object offset lowtag)))
  25 ;;;
  26 (define-vop (cell-set)
  27   (:args (object :scs (descriptor-reg))
  28          (value :scs (descriptor-reg any-reg)))
  29   (:variant-vars offset lowtag)
  30   (:policy :fast-safe)
  31   (:generator 4
  32     (storew value object offset lowtag)))
  33
  34 ;;; Slot-Ref and Slot-Set are used to define VOPs like Closure-Ref, where the
  35 ;;; offset is constant at compile time, but varies for different uses.  We add
  36 ;;; in the standard g-vector overhead.
  37 ;;;
  38 (define-vop (slot-ref)
  39   (:args (object :scs (descriptor-reg)))
  40   (:results (value :scs (descriptor-reg any-reg)))
  41   (:variant-vars base lowtag)
  42   (:info offset)
  43   (:generator 4
  44     (loadw value object (+ base offset) lowtag)))
  45 ;;;
  46 (define-vop (slot-set)
  47   (:args (object :scs (descriptor-reg))
  48          (value :scs (descriptor-reg any-reg)))
  49   (:variant-vars base lowtag)
  50   (:info offset)
  51   (:generator 4
  52     (storew value object (+ base offset) lowtag)))
  53
  54
  55 \f
  56 ;;;; Indexed references:
  57
  58 ;;; Define some VOPs for indexed memory reference.
  59 (defmacro define-indexer (name write-p ri-op rr-op shift &optional sign-extend-byte)
  60   `(define-vop (,name)
  61      (:args (object :scs (descriptor-reg))
  62             (index :scs (any-reg zero immediate))
  63             ,@(when write-p
  64                 '((value :scs (any-reg descriptor-reg) :target result))))
  65      (:arg-types * tagged-num ,@(when write-p '(*)))
  66      (:temporary (:scs (non-descriptor-reg)) temp)
  67      (:results (,(if write-p 'result 'value)
  68                 :scs (any-reg descriptor-reg)))
  69      (:result-types *)
  70      (:variant-vars offset lowtag)
  71      (:policy :fast-safe)
  72      (:generator 5
  73        (sc-case index
  74          ((immediate zero)
  75           (let ((offset (- (+ (if (sc-is index zero)
  76                                   0
  77                                   (ash (tn-value index)
  78                                        (- word-shift ,shift)))
  79                               (ash offset word-shift))
  80                            lowtag)))
  81             (etypecase offset
  82               ((signed-byte 16)
  83                (inst ,ri-op value object offset))
  84               ((or (unsigned-byte 32) (signed-byte 32))
  85                (inst lr temp offset)
  86                (inst ,rr-op value object temp)))))
  87          (t
  88           ,@(unless (zerop shift)
  89               `((inst srwi temp index ,shift)))
  90           (inst addi temp ,(if (zerop shift) 'index 'temp)
  91                 (- (ash offset word-shift) lowtag))
  92           (inst ,rr-op value object temp)))
  93        ,@(when sign-extend-byte
  94            `((inst extsb value value)))
  95        ,@(when write-p
  96            '((move result value))))))
  97
  98 (define-indexer word-index-ref nil lwz lwzx 0)
  99 (define-indexer word-index-set t stw stwx 0)
 100 (define-indexer halfword-index-ref nil lhz lhzx 1)
 101 (define-indexer signed-halfword-index-ref nil lha lhax 1)
 102 (define-indexer halfword-index-set t sth sthx 1)
 103 (define-indexer byte-index-ref nil lbz lbzx 2)
 104 (define-indexer signed-byte-index-ref nil lbz lbzx 2 t)
 105 (define-indexer byte-index-set t stb stbx 2)
 106
 107 #!+compare-and-swap-vops
 108 (define-vop (word-index-cas)
 109   (:args (object :scs (descriptor-reg))
 110          (index :scs (any-reg zero immediate))
 111          (old-value :scs (any-reg descriptor-reg))
 112          (new-value :scs (any-reg descriptor-reg)))
 113   (:arg-types * tagged-num * *)
 114   (:temporary (:sc non-descriptor-reg) temp)
 115   (:results (result :scs (any-reg descriptor-reg) :from :load))
 116   (:result-types *)
 117   (:variant-vars offset lowtag)
 118   (:policy :fast-safe)
 119   (:generator 5
 120     (sc-case index
 121       ((immediate zero)
 122        (let ((offset (- (+ (if (sc-is index zero)
 123                                0
 124                              (ash (tn-value index) word-shift))
 125                            (ash offset word-shift))
 126                         lowtag)))
 127          (inst lr temp offset)))
 128       (t
 129        ;; KLUDGE: This relies on N-FIXNUM-TAG-BITS being the same as
 130        ;; WORD-SHIFT.  I know better than to do this.  --AB, 2010-Jun-16
 131        (inst addi temp index
 132              (- (ash offset word-shift) lowtag))))
 133
 134     (inst sync)
 135     LOOP
 136     (inst lwarx result temp object)
 137     (inst cmpw result old-value)
 138     (inst bne EXIT)
 139     (inst stwcx. new-value temp object)
 140     (inst bne LOOP)
 141     EXIT
 142     (inst isync)))