src/compiler/x86/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-for-object-slot object offset lowtag)
  82           value)))
  83
  84 ;;; SLOT-REF and SLOT-SET are used to define VOPs like CLOSURE-REF,
  85 ;;; where the offset is constant at compile time, but varies for
  86 ;;; different uses.
  87 (define-vop (slot-ref)
  88   (:args (object :scs (descriptor-reg)))
  89   (:results (value :scs (descriptor-reg any-reg)))
  90   (:variant-vars base lowtag)
  91   (:info offset)
  92   (:generator 4
  93     (loadw value object (+ base offset) lowtag)))
  94 (define-vop (slot-set)
  95   (:args (object :scs (descriptor-reg))
  96          (value :scs (descriptor-reg any-reg immediate)))
  97   (:variant-vars base lowtag)
  98   (:info offset)
  99   (:generator 4
 100      (storew (encode-value-if-immediate value) object (+ base offset) lowtag)))
 101
 102 (define-vop (slot-set-conditional)
 103   (:args (object :scs (descriptor-reg) :to :eval)
 104          (old-value :scs (descriptor-reg any-reg) :target eax)
 105          (new-value :scs (descriptor-reg any-reg) :target temp))
 106   (:temporary (:sc descriptor-reg :offset eax-offset
 107                    :from (:argument 1) :to :result :target result)  eax)
 108   (:temporary (:sc descriptor-reg :from (:argument 2) :to :result) temp)
 109   (:variant-vars base lowtag)
 110   (:results (result :scs (descriptor-reg)))
 111   (:info offset)
 112   (:generator 4
 113     (move eax old-value)
 114     (move temp new-value)
 115     (inst cmpxchg (make-ea-for-object-slot object (+ base offset) lowtag)
 116           temp)
 117     (move result eax)))
 118
 119 ;;; X86 special
 120 (define-vop (slot-xadd)
 121   (:args (object :scs (descriptor-reg) :to :result)
 122          (value :scs (any-reg) :target result))
 123   (:results (result :scs (any-reg) :from (:argument 1)))
 124   (:result-types tagged-num)
 125   (:variant-vars base lowtag)
 126   (:info offset)
 127   (:generator 4
 128     (move result value)
 129     (inst xadd (make-ea-for-object-slot object (+ base offset) lowtag)
 130           value)))