src/compiler/x86-64/memory.lisp

   1 ;;;; the x86 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
  15 ;;; CELL-REF and CELL-SET are used to define VOPs like CAR, where the
  16 ;;; offset to be read or written is a property of the VOP used.
  17 ;;; CELL-SETF is similar to CELL-SET, but delivers the new value as
  18 ;;; the result. CELL-SETF-FUN takes its arguments as if it were a
  19 ;;; SETF function (new value first, as apposed to a SETF macro, which
  20 ;;; takes the new value last).
  21 (define-vop (cell-ref)
  22   (:args (object :scs (descriptor-reg)))
  23   (:results (value :scs (descriptor-reg any-reg)))
  24   (:variant-vars offset lowtag)
  25   (:policy :fast-safe)
  26   (:generator 4
  27     (loadw value object offset lowtag)))
  28 (define-vop (cell-set)
  29   (:args (object :scs (descriptor-reg))
  30          (value :scs (descriptor-reg any-reg)))
  31   (:variant-vars offset lowtag)
  32   (:policy :fast-safe)
  33   (:generator 4
  34     (storew value object offset lowtag)))
  35 (define-vop (cell-setf)
  36   (:args (object :scs (descriptor-reg))
  37          (value :scs (descriptor-reg any-reg) :target result))
  38   (:results (result :scs (descriptor-reg any-reg)))
  39   (:variant-vars offset lowtag)
  40   (:policy :fast-safe)
  41   (:generator 4
  42     (storew value object offset lowtag)
  43     (move result value)))
  44 (define-vop (cell-setf-fun)
  45   (:args (value :scs (descriptor-reg any-reg) :target result)
  46          (object :scs (descriptor-reg)))
  47   (:results (result :scs (descriptor-reg any-reg)))
  48   (:variant-vars offset lowtag)
  49   (:policy :fast-safe)
  50   (:generator 4
  51     (storew value object offset lowtag)
  52     (move result value)))
  53
  54 ;;; Define accessor VOPs for some cells in an object. If the operation
  55 ;;; name is NIL, then that operation isn't defined. If the translate
  56 ;;; function is null, then we don't define a translation.
  57 (defmacro define-cell-accessors (offset lowtag
  58                                         ref-op ref-trans set-op set-trans)
  59   `(progn
  60      ,@(when ref-op
  61          `((define-vop (,ref-op cell-ref)
  62              (:variant ,offset ,lowtag)
  63              ,@(when ref-trans
  64                  `((:translate ,ref-trans))))))
  65      ,@(when set-op
  66          `((define-vop (,set-op cell-setf)
  67              (:variant ,offset ,lowtag)
  68              ,@(when set-trans
  69                  `((:translate ,set-trans))))))))
  70
  71 ;;; X86 special
  72 (define-vop (cell-xadd)
  73   (:args (object :scs (descriptor-reg) :to :result)
  74          (value :scs (any-reg) :target result))
  75   (:results (result :scs (any-reg) :from (:argument 1)))
  76   (:result-types tagged-num)
  77   (:variant-vars offset lowtag)
  78   (:policy :fast-safe)
  79   (:generator 4
  80     (move result value)
  81     (inst xadd (make-ea :dword :base object
  82                         :disp (- (* offset n-word-bytes) lowtag))
  83           value)))
  84
  85 ;;; SLOT-REF and SLOT-SET are used to define VOPs like CLOSURE-REF,
  86 ;;; where the offset is constant at compile time, but varies for
  87 ;;; different uses.
  88 (define-vop (slot-ref)
  89   (:args (object :scs (descriptor-reg)))
  90   (:results (value :scs (descriptor-reg any-reg)))
  91   (:variant-vars base lowtag)
  92   (:info offset)
  93   (:generator 4
  94     (loadw value object (+ base offset) lowtag)))
  95 (define-vop (slot-set)
  96   (:args (object :scs (descriptor-reg))
  97          (value :scs (descriptor-reg any-reg immediate)))
  98   (:temporary (:sc unsigned-reg) temp)
  99   (:variant-vars base lowtag)
 100   (:info offset)
 101   (:generator 4
 102      (if (sc-is value immediate)
 103          (let ((val (tn-value value)))
 104            (move-immediate (make-ea :qword :base object
 105                                     :disp (- (* (+ base offset) n-word-bytes)
 106                                              lowtag))
 107                            (etypecase val
 108                              (integer
 109                               (fixnumize val))
 110                              (symbol
 111                               (+ nil-value (static-symbol-offset val)))
 112                              (character
 113                               (logior (ash (char-code val) n-widetag-bits)
 114                                       character-widetag)))
 115                            temp))
 116          ;; Else, value not immediate.
 117          (storew value object (+ base offset) lowtag))))
 118
 119 (define-vop (slot-set-conditional)
 120   (:args (object :scs (descriptor-reg) :to :eval)
 121          (old-value :scs (descriptor-reg any-reg) :target eax)
 122          (new-value :scs (descriptor-reg any-reg) :target temp))
 123   (:temporary (:sc descriptor-reg :offset eax-offset
 124                    :from (:argument 1) :to :result :target result)  eax)
 125   (:temporary (:sc descriptor-reg :from (:argument 2) :to :result) temp)
 126   (:variant-vars base lowtag)
 127   (:results (result :scs (descriptor-reg)))
 128   (:info offset)
 129   (:generator 4
 130     (move eax old-value)
 131     (move temp new-value)
 132     (inst cmpxchg (make-ea :dword :base object
 133                            :disp (- (* (+ base offset) n-word-bytes) lowtag))
 134           temp)
 135     (move result eax)))
 136
 137 ;;; X86 special
 138 (define-vop (slot-xadd)
 139   (:args (object :scs (descriptor-reg) :to :result)
 140          (value :scs (any-reg) :target result))
 141   (:results (result :scs (any-reg) :from (:argument 1)))
 142   (:result-types tagged-num)
 143   (:variant-vars base lowtag)
 144   (:info offset)
 145   (:generator 4
 146     (move result value)
 147     (inst xadd (make-ea :dword :base object
 148                         :disp (- (* (+ base offset) n-word-bytes) lowtag))
 149           value)))