;;;; the x86 definitions of some general purpose memory reference VOPs
;;;; inherited by basic memory reference operations

  This software is part of the SBCL system . See the README file for
;;;; more information.
;;;;
  This software is derived from the CMU CL system , which was
  written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.

(in-package "SB!VM")

;;; CELL-REF and CELL-SET are used to define VOPs like CAR, where the
  offset to be read or written is a property of the VOP used .
  CELL - SETF is similar to CELL - SET , but delivers the new value as
;;; the result. CELL-SETF-FUN takes its arguments as if it were a
  SETF function ( new value first , as apposed to a SETF macro , which
;;; takes the new value last).
(define-vop (cell-ref)
  (:args (object :scs (descriptor-reg)))
  (:results (value :scs (descriptor-reg any-reg)))
  (:variant-vars offset lowtag)
  (:policy :fast-safe)
  (:generator 4
    (loadw value object offset lowtag)))
(define-vop (cell-set)
  (:args (object :scs (descriptor-reg))
         (value :scs (descriptor-reg any-reg)))
  (:variant-vars offset lowtag)
  (:policy :fast-safe)
  (:generator 4
    (storew value object offset lowtag)))
(define-vop (cell-setf)
  (:args (object :scs (descriptor-reg))
         (value :scs (descriptor-reg any-reg) :target result))
  (:results (result :scs (descriptor-reg any-reg)))
  (:variant-vars offset lowtag)
  (:policy :fast-safe)
  (:generator 4
    (storew value object offset lowtag)
    (move result value)))
(define-vop (cell-setf-fun)
  (:args (value :scs (descriptor-reg any-reg) :target result)
         (object :scs (descriptor-reg)))
  (:results (result :scs (descriptor-reg any-reg)))
  (:variant-vars offset lowtag)
  (:policy :fast-safe)
  (:generator 4
    (storew value object offset lowtag)
    (move result value)))

;;; Define accessor VOPs for some cells in an object. If the operation
  name is NIL , then that operation is n't defined . If the translate
;;; function is null, then we don't define a translation.
(defmacro define-cell-accessors (offset lowtag
                                        ref-op ref-trans set-op set-trans)
  `(progn
     ,@(when ref-op
         `((define-vop (,ref-op cell-ref)
             (:variant ,offset ,lowtag)
             ,@(when ref-trans
                 `((:translate ,ref-trans))))))
     ,@(when set-op
         `((define-vop (,set-op cell-setf)
             (:variant ,offset ,lowtag)
             ,@(when set-trans
                 `((:translate ,set-trans))))))))

;;; X86 special
(define-vop (cell-xadd)
  (:args (object :scs (descriptor-reg) :to :result)
         (value :scs (any-reg) :target result))
  (:results (result :scs (any-reg) :from (:argument 1)))
  (:result-types tagged-num)
  (:variant-vars offset lowtag)
  (:policy :fast-safe)
  (:generator 4
    (move result value)
    (inst xadd (make-ea :dword :base object
                        :disp (- (* offset n-word-bytes) lowtag))
          value)))

  SLOT - REF and SLOT - SET are used to define VOPs like CLOSURE - REF ,
;;; where the offset is constant at compile time, but varies for
;;; different uses.
(define-vop (slot-ref)
  (:args (object :scs (descriptor-reg)))
  (:results (value :scs (descriptor-reg any-reg)))
  (:variant-vars base lowtag)
  (:info offset)
  (:generator 4
    (loadw value object (+ base offset) lowtag)))
(define-vop (slot-set)
  (:args (object :scs (descriptor-reg))
         (value :scs (descriptor-reg any-reg immediate)))
  (:temporary (:sc unsigned-reg) temp)
  (:variant-vars base lowtag)
  (:info offset)
  (:generator 4
     (if (sc-is value immediate)
         (let ((val (tn-value value)))
           (move-immediate (make-ea :qword :base object
                                    :disp (- (* (+ base offset) n-word-bytes)
                                             lowtag))
                           (etypecase val
                             (integer
                              (fixnumize val))
                             (symbol
                              (+ nil-value (static-symbol-offset val)))
                             (character
                              (logior (ash (char-code val) n-widetag-bits)
                                      character-widetag)))
                           temp))
         ;; Else, value not immediate.
         (storew value object (+ base offset) lowtag))))

(define-vop (slot-set-conditional)
  (:args (object :scs (descriptor-reg) :to :eval)
         (old-value :scs (descriptor-reg any-reg) :target eax)
         (new-value :scs (descriptor-reg any-reg) :target temp))
  (:temporary (:sc descriptor-reg :offset eax-offset
                   :from (:argument 1) :to :result :target result)  eax)
  (:temporary (:sc descriptor-reg :from (:argument 2) :to :result) temp)
  (:variant-vars base lowtag)
  (:results (result :scs (descriptor-reg)))
  (:info offset)
  (:generator 4
    (move eax old-value)
    (move temp new-value)
    (inst cmpxchg (make-ea :dword :base object
                           :disp (- (* (+ base offset) n-word-bytes) lowtag))
          temp)
    (move result eax)))

;;; X86 special
(define-vop (slot-xadd)
  (:args (object :scs (descriptor-reg) :to :result)
         (value :scs (any-reg) :target result))
  (:results (result :scs (any-reg) :from (:argument 1)))
  (:result-types tagged-num)
  (:variant-vars base lowtag)
  (:info offset)
  (:generator 4
    (move result value)
    (inst xadd (make-ea :dword :base object
                        :disp (- (* (+ base offset) n-word-bytes) lowtag))
          value)))

 the x86 definitions of some general purpose memory reference VOPs
 inherited by basic memory reference operations
 more information.

 public domain. The software is in the public domain and is
 provided with absolutely no warranty. See the COPYING and CREDITS
 files for more information.
 CELL-REF and CELL-SET are used to define VOPs like CAR, where the
 the result. CELL-SETF-FUN takes its arguments as if it were a
 takes the new value last).
 Define accessor VOPs for some cells in an object. If the operation
 function is null, then we don't define a translation.
 X86 special
 where the offset is constant at compile time, but varies for
 different uses.
 Else, value not immediate.
 X86 special

  This software is part of the SBCL system . See the README file for
  This software is derived from the CMU CL system , which was
  written at Carnegie Mellon University and released into the

(in-package "SB!VM")

  offset to be read or written is a property of the VOP used .
  CELL - SETF is similar to CELL - SET , but delivers the new value as
  SETF function ( new value first , as apposed to a SETF macro , which
(define-vop (cell-ref)
  (:args (object :scs (descriptor-reg)))
  (:results (value :scs (descriptor-reg any-reg)))
  (:variant-vars offset lowtag)
  (:policy :fast-safe)
  (:generator 4
    (loadw value object offset lowtag)))
(define-vop (cell-set)
  (:args (object :scs (descriptor-reg))
         (value :scs (descriptor-reg any-reg)))
  (:variant-vars offset lowtag)
  (:policy :fast-safe)
  (:generator 4
    (storew value object offset lowtag)))
(define-vop (cell-setf)
  (:args (object :scs (descriptor-reg))
         (value :scs (descriptor-reg any-reg) :target result))
  (:results (result :scs (descriptor-reg any-reg)))
  (:variant-vars offset lowtag)
  (:policy :fast-safe)
  (:generator 4
    (storew value object offset lowtag)
    (move result value)))
(define-vop (cell-setf-fun)
  (:args (value :scs (descriptor-reg any-reg) :target result)
         (object :scs (descriptor-reg)))
  (:results (result :scs (descriptor-reg any-reg)))
  (:variant-vars offset lowtag)
  (:policy :fast-safe)
  (:generator 4
    (storew value object offset lowtag)
    (move result value)))

  name is NIL , then that operation is n't defined . If the translate
(defmacro define-cell-accessors (offset lowtag
                                        ref-op ref-trans set-op set-trans)
  `(progn
     ,@(when ref-op
         `((define-vop (,ref-op cell-ref)
             (:variant ,offset ,lowtag)
             ,@(when ref-trans
                 `((:translate ,ref-trans))))))
     ,@(when set-op
         `((define-vop (,set-op cell-setf)
             (:variant ,offset ,lowtag)
             ,@(when set-trans
                 `((:translate ,set-trans))))))))

(define-vop (cell-xadd)
  (:args (object :scs (descriptor-reg) :to :result)
         (value :scs (any-reg) :target result))
  (:results (result :scs (any-reg) :from (:argument 1)))
  (:result-types tagged-num)
  (:variant-vars offset lowtag)
  (:policy :fast-safe)
  (:generator 4
    (move result value)
    (inst xadd (make-ea :dword :base object
                        :disp (- (* offset n-word-bytes) lowtag))
          value)))

  SLOT - REF and SLOT - SET are used to define VOPs like CLOSURE - REF ,
(define-vop (slot-ref)
  (:args (object :scs (descriptor-reg)))
  (:results (value :scs (descriptor-reg any-reg)))
  (:variant-vars base lowtag)
  (:info offset)
  (:generator 4
    (loadw value object (+ base offset) lowtag)))
(define-vop (slot-set)
  (:args (object :scs (descriptor-reg))
         (value :scs (descriptor-reg any-reg immediate)))
  (:temporary (:sc unsigned-reg) temp)
  (:variant-vars base lowtag)
  (:info offset)
  (:generator 4
     (if (sc-is value immediate)
         (let ((val (tn-value value)))
           (move-immediate (make-ea :qword :base object
                                    :disp (- (* (+ base offset) n-word-bytes)
                                             lowtag))
                           (etypecase val
                             (integer
                              (fixnumize val))
                             (symbol
                              (+ nil-value (static-symbol-offset val)))
                             (character
                              (logior (ash (char-code val) n-widetag-bits)
                                      character-widetag)))
                           temp))
         (storew value object (+ base offset) lowtag))))

(define-vop (slot-set-conditional)
  (:args (object :scs (descriptor-reg) :to :eval)
         (old-value :scs (descriptor-reg any-reg) :target eax)
         (new-value :scs (descriptor-reg any-reg) :target temp))
  (:temporary (:sc descriptor-reg :offset eax-offset
                   :from (:argument 1) :to :result :target result)  eax)
  (:temporary (:sc descriptor-reg :from (:argument 2) :to :result) temp)
  (:variant-vars base lowtag)
  (:results (result :scs (descriptor-reg)))
  (:info offset)
  (:generator 4
    (move eax old-value)
    (move temp new-value)
    (inst cmpxchg (make-ea :dword :base object
                           :disp (- (* (+ base offset) n-word-bytes) lowtag))
          temp)
    (move result eax)))

(define-vop (slot-xadd)
  (:args (object :scs (descriptor-reg) :to :result)
         (value :scs (any-reg) :target result))
  (:results (result :scs (any-reg) :from (:argument 1)))
  (:result-types tagged-num)
  (:variant-vars base lowtag)
  (:info offset)
  (:generator 4
    (move result value)
    (inst xadd (make-ea :dword :base object
                        :disp (- (* (+ base offset) n-word-bytes) lowtag))
          value)))
