Pun double-float vectors as complex double-float vectors

sb-complex-puns

(defpackage "COMPLEX-PUNS"
    (:use "CL")
  (:export "%CDREF" "CDREF" "%CDSET" "CDSET"))

(in-package "COMPLEX-PUNS")
(deftype index ()
  `(mod ,array-dimension-limit))

(sb-c:defknown (%cdref cdref) ((simple-array double-float 1) index) (complex double-float)
    (sb-c:flushable sb-c:movable sb-c:foldable))

(sb-c:defknown (%cdset cdset) ((complex double-float) (simple-array double-float 1) index)
    (values))

(in-package "SB-VM")
(define-vop (%%cdref)
  (:policy :fast-safe)
  (:args (vector :scs (descriptor-reg))
         (index  :scs (any-reg)))
  (:arg-types simple-array-double-float tagged-num)
  (:results (value :scs (complex-double-reg)))
  (:result-types complex-double-float)
  (:variant-vars aligned)
  (:generator 3
     (let ((ea (make-ea :qword :base vector :index index
                        :disp (- (* n-word-bytes vector-data-offset)
                                 other-pointer-lowtag))))
       (if aligned
           (inst movapd value ea)
           (inst movupd value ea)))))

(define-vop (%%cdset)
  (:policy :fast-safe)
  (:args (value  :scs (complex-double-reg))
         (vector :scs (descriptor-reg))
         (index  :scs (any-reg)))
  (:arg-types complex-double-float simple-array-double-float tagged-num)
  (:results)
  (:result-types)
  (:variant-vars aligned)
  (:generator 3
     (let ((ea (make-ea :qword :base vector :index index
                        :disp (- (* n-word-bytes vector-data-offset)
                                 other-pointer-lowtag))))
       (if aligned
           (inst movapd ea value)
           (inst movupd ea value)))))

(define-vop (cdref %%cdref)
  (:translate complex-puns:cdref)
  (:variant nil))

(define-vop (%cdref %%cdref)
  (:translate complex-puns:%cdref)
  (:variant t))

(define-vop (cdset %%cdset)
  (:translate complex-puns:cdset)
  (:variant nil))

(define-vop (%cdset %%cdset)
  (:translate complex-puns:%cdset)
  (:variant t))
(in-package "COMPLEX-PUNS")

(defun cdref (vector index)
  (declare (type (simple-array double-float 1) vector)
           (type index index))
  (cdref vector index))

(defun %cdref (vector index)
  (declare (type (simple-array double-float 1) vector)
           (type index index))
  (%cdref vector index))

(defun cdset (value vector index)
  (declare (type (complex double-float) value)
           (type (simple-array double-float 1) vector)
           (type index index))
  (cdset value vector index))

(defun %cdset (value vector index)
  (declare (type (complex double-float) value)
           (type (simple-array double-float 1) vector)
           (type index index))
  (%cdset value vector index))

(declaim (inline (setf cdref) (setf %cdref)))
(defun (setf cdref) (value vector index)
  (cdset value vector index)
  value)
(defun (setf %cdref) (value vector index)
  (%cdset value vector index)
  value)