Commit 6caf614c authored by Nathan Froyd's avatar Nathan Froyd
Browse files

tweak function argument names for better documentation

parent df065736

vectors.lisp

+68 −68
Original line number Diff line number Diff line
@@ -65,11 +65,11 @@ BIG-ENDIAN-P. The form returns VALUE-NAME." 
(macrolet ((define-fetcher (bitsize signedp big-endian-p)

             (let ((ref-name (byte-ref-fun-name bitsize signedp big-endian-p))

                   (bytes (truncate bitsize 8)))

               `(defun ,ref-name (buffer index)

                  (declare (type octet-vector buffer))

               `(defun ,ref-name (vector index)

                  (declare (type octet-vector vector))

                  (declare (type (integer 0 ,(- array-dimension-limit bytes)) index))

                  (multiple-value-bind (vector start end)

                      (array-data-and-offsets buffer index (+ index ,bytes))

                      (array-data-and-offsets vector index (+ index ,bytes))

                     #+sbcl (declare (optimize (sb-c::insert-array-bounds-checks 0)))

                     (declare (type (integer 0 ,(- array-dimension-limit bytes)) start))

                    (declare (ignore end))
@@ -79,14 +79,14 @@ BIG-ENDIAN-P. The form returns VALUE-NAME." 
                   (set-name (byte-set-fun-name bitsize signedp big-endian-p))

                   (bytes (truncate bitsize 8)))

               `(progn

                 (defun ,set-name (buffer index value)

                   (declare (type octet-vector buffer))

                 (defun ,set-name (vector index value)

                   (declare (type octet-vector vector))

                   (declare (type (integer 0 ,(- array-dimension-limit bytes)) index))

                   (declare (type (,(if signedp

                                        'signed-byte

                                        'unsigned-byte) ,bitsize) value))

                   (multiple-value-bind (vector start end)

                       (array-data-and-offsets buffer index (+ index ,bytes))

                       (array-data-and-offsets vector index (+ index ,bytes))

                     #+sbcl (declare (optimize (sb-c::insert-array-bounds-checks 0)))

                     (declare (type (integer 0 ,(- array-dimension-limit bytes)) start))

                     (declare (ignore end))
@@ -106,19 +106,19 @@ BIG-ENDIAN-P. The form returns VALUE-NAME." 
(defun not-supported ()

  (error "not supported"))



(defun ieee-single-ref/be (buffer index)

  (declare (ignorable buffer index))

(defun ieee-single-ref/be (vector index)

  (declare (ignorable vector index))

  #+sbcl

  (sb-kernel:make-single-float (sb32ref/be buffer index))

  (sb-kernel:make-single-float (sb32ref/be vector index))

  #+cmu

  (kernel:make-single-float (sb32ref/be buffer index))

  (kernel:make-single-float (sb32ref/be vector index))

  #+ccl

  (ccl::host-single-float-from-unsigned-byte-32 (ub32ref/be buffer index))

  (ccl::host-single-float-from-unsigned-byte-32 (ub32ref/be vector index))

  #+allegro

  (let ((b (ub32ref/be buffer index)))

  (let ((b (ub32ref/be vector index)))

    (excl:shorts-to-single-float (ldb (byte 16 16) b) (ldb (byte 16 0) b)))

  #+lispworks

  (let* ((ub (ub32ref/be buffer index))

  (let* ((ub (ub32ref/be vector index))

         (v (sys:make-typed-aref-vector 4)))

    (declare (optimize (speed 3) (float 0) (safety 0)))

    (declare (dynamic-extent v))
@@ -127,48 +127,48 @@ BIG-ENDIAN-P. The form returns VALUE-NAME." 
  #-(or sbcl cmu ccl allegro lispworks)

  (not-supported))



(defun (setf ieee-single-ref/be) (value buffer index)

  (declare (ignorable value buffer index))

(defun (setf ieee-single-ref/be) (value vector index)

  (declare (ignorable value vector index))

  #+sbcl

  (progn

    (setf (sb32ref/be buffer index) (sb-kernel:single-float-bits value))

    (setf (sb32ref/be vector index) (sb-kernel:single-float-bits value))

    value)

  #+cmu

  (progn

    (setf (sb32ref/be buffer index) (kernel:single-float-bits value))

    (setf (sb32ref/be vector index) (kernel:single-float-bits value))

    value)

  #+ccl

  (progn

    (setf (ub32ref/be buffer index) (ccl::single-float-bits value))

    (setf (ub32ref/be vector index) (ccl::single-float-bits value))

    value)

  #+allegro

  (multiple-value-bind (hi lo) (excl:single-float-to-shorts value)

    (setf (ub16ref/be buffer index) hi

          (ub16ref/be buffer (+ index 2) lo))

    (setf (ub16ref/be vector index) hi

          (ub16ref/be vector (+ index 2) lo))

    value)

  #+lispworks

  (let* ((v (sys:make-typed-aref-vector 4)))

    (declare (optimize (speed 3) (float 0) (safety 0)))

    (declare (dynamic-extent v))

    (setf (sys:typed-aref 'single-float v 0) value)

    (setf (ub32ref/be buffer index) (sys:typed-aref '(unsigned-byte 32) v 0))

    (setf (ub32ref/be vector index) (sys:typed-aref '(unsigned-byte 32) v 0))

    value)

  #-(or sbcl cmu ccl allegro lispworks)

  (not-supported))



(defun ieee-single-ref/le (buffer index)

  (declare (ignorable buffer index))

(defun ieee-single-ref/le (vector index)

  (declare (ignorable vector index))

  #+sbcl

  (sb-kernel:make-single-float (sb32ref/le buffer index))

  (sb-kernel:make-single-float (sb32ref/le vector index))

  #+cmu

  (kernel:make-single-float (sb32ref/le buffer index))

  (kernel:make-single-float (sb32ref/le vector index))

  #+ccl

  (ccl::host-single-float-from-unsigned-byte-32 (ub32ref/le buffer index))

  (ccl::host-single-float-from-unsigned-byte-32 (ub32ref/le vector index))

  #+allegro

  (let ((b (ub32ref/le buffer index)))

  (let ((b (ub32ref/le vector index)))

    (excl:shorts-to-single-float (ldb (byte 16 16) b) (ldb (byte 16 0) b)))

  #+lispworks

  (let* ((ub (ub32ref/le buffer index))

  (let* ((ub (ub32ref/le vector index))

         (v (sys:make-typed-aref-vector 4)))

    (declare (optimize (speed 3) (float 0) (safety 0)))

    (declare (dynamic-extent v))
@@ -177,105 +177,105 @@ BIG-ENDIAN-P. The form returns VALUE-NAME." 
  #-(or sbcl cmu ccl allegro lispworks)

  (not-supported))



(defun (setf ieee-single-ref/le) (value buffer index)

  (declare (ignorable value buffer index))

(defun (setf ieee-single-ref/le) (value vector index)

  (declare (ignorable value vector index))

  #+sbcl

  (progn

    (setf (sb32ref/le buffer index) (sb-kernel:single-float-bits value))

    (setf (sb32ref/le vector index) (sb-kernel:single-float-bits value))

    value)

  #+cmu

  (progn

    (setf (sb32ref/le buffer index) (kernel:single-float-bits value))

    (setf (sb32ref/le vector index) (kernel:single-float-bits value))

    value)

  #+ccl

  (progn

    (setf (ub32ref/le buffer index) (ccl::single-float-bits value))

    (setf (ub32ref/le vector index) (ccl::single-float-bits value))

    value)

  #+allegro

  (multiple-value-bind (hi lo) (excl:single-float-to-shorts value)

    (setf (ub16ref/le buffer (+ index 2)) hi

          (ub16ref/le buffer index lo))

    (setf (ub16ref/le vector (+ index 2)) hi

          (ub16ref/le vector index lo))

    value)

  #+lispworks

  (let* ((v (sys:make-typed-aref-vector 4)))

    (declare (optimize (speed 3) (float 0) (safety 0)))

    (declare (dynamic-extent v))

    (setf (sys:typed-aref 'single-float v 0) value)

    (setf (ub32ref/le buffer index) (sys:typed-aref '(unsigned-byte 32) v 0))

    (setf (ub32ref/le vector index) (sys:typed-aref '(unsigned-byte 32) v 0))

    value)

  #-(or sbcl cmu ccl allegro lispworks)

  (not-supported))



(defun ieee-double-ref/be (buffer index)

  (declare (ignorable buffer index))

(defun ieee-double-ref/be (vector index)

  (declare (ignorable vector index))

  #+sbcl

  (let ((upper (sb32ref/be buffer index))

        (lower (ub32ref/be buffer (+ index 4))))

  (let ((upper (sb32ref/be vector index))

        (lower (ub32ref/be vector (+ index 4))))

    (sb-kernel:make-double-float upper lower))

  #+cmu

  (let ((upper (sb32ref/be buffer index))

        (lower (ub32ref/be buffer (+ index 4))))

  (let ((upper (sb32ref/be vector index))

        (lower (ub32ref/be vector (+ index 4))))

    (kernel:make-double-float upper lower))

  #+ccl

  (let ((upper (ub32ref/be buffer index))

        (lower (ub32ref/be buffer (+ index 4))))

  (let ((upper (ub32ref/be vector index))

        (lower (ub32ref/be vector (+ index 4))))

    (ccl::make-double-float-from-bits upper lower))

  #-(or sbcl cmu ccl)

  (not-supported))



(defun (setf ieee-double-ref/be) (value buffer index)

  (declare (ignorable value buffer index))

(defun (setf ieee-double-ref/be) (value vector index)

  (declare (ignorable value vector index))

  #+sbcl

  (progn

    (setf (sb32ref/be buffer index) (sb-kernel:double-float-high-bits value)

          (ub32ref/be buffer (+ index 4)) (sb-kernel:double-float-low-bits value))

    (setf (sb32ref/be vector index) (sb-kernel:double-float-high-bits value)

          (ub32ref/be vector (+ index 4)) (sb-kernel:double-float-low-bits value))

    value)

  #+cmu

  (progn

    (setf (sb32ref/be buffer index) (kernel:double-float-high-bits value)

          (ub32ref/be buffer (+ index 4)) (kernel:double-float-low-bits value))

    (setf (sb32ref/be vector index) (kernel:double-float-high-bits value)

          (ub32ref/be vector (+ index 4)) (kernel:double-float-low-bits value))

    value)

  #+ccl

  (multiple-value-bind (upper lower) (ccl::double-float-bits value)

    (setf (ub32ref/be buffer index) upper

          (ub32ref/be buffer (+ index 4)) lower)

    (setf (ub32ref/be vector index) upper

          (ub32ref/be vector (+ index 4)) lower)

    value)

  #-(or sbcl cmu ccl)

  (not-supported))



(defun ieee-double-ref/le (buffer index)

  (declare (ignorable buffer index))

(defun ieee-double-ref/le (vector index)

  (declare (ignorable vector index))

  #+sbcl

  (let ((upper (sb32ref/le buffer (+ index 4)))

        (lower (ub32ref/le buffer index)))

  (let ((upper (sb32ref/le vector (+ index 4)))

        (lower (ub32ref/le vector index)))

    (sb-kernel:make-double-float upper lower))

  #+cmu

  (let ((upper (sb32ref/le buffer (+ index 4)))

        (lower (ub32ref/le buffer index)))

  (let ((upper (sb32ref/le vector (+ index 4)))

        (lower (ub32ref/le vector index)))

    (kernel:make-double-float upper lower))

  #+ccl

  (let ((upper (ub32ref/le buffer (+ index 4)))

        (lower (ub32ref/le buffer index)))

  (let ((upper (ub32ref/le vector (+ index 4)))

        (lower (ub32ref/le vector index)))

    (ccl::make-double-float-from-bits upper lower))

  #-(or sbcl cmu ccl)

  (not-supported))



(defun (setf ieee-double-ref/le) (value buffer index)

  (declare (ignorable value buffer index))

(defun (setf ieee-double-ref/le) (value vector index)

  (declare (ignorable value vector index))

  #+sbcl

  (progn

    (setf (sb32ref/le buffer (+ index 4)) (sb-kernel:double-float-high-bits value)

          (ub32ref/le buffer index) (sb-kernel:double-float-low-bits value))

    (setf (sb32ref/le vector (+ index 4)) (sb-kernel:double-float-high-bits value)

          (ub32ref/le vector index) (sb-kernel:double-float-low-bits value))

    value)

  #+cmu

  (progn

    (setf (sb32ref/le buffer (+ index 4)) (kernel:double-float-high-bits value)

          (ub32ref/le buffer index) (kernel:double-float-low-bits value))

    (setf (sb32ref/le vector (+ index 4)) (kernel:double-float-high-bits value)

          (ub32ref/le vector index) (kernel:double-float-low-bits value))

    value)

  #+ccl

  (multiple-value-bind (upper lower) (ccl::double-float-bits value)

    (setf (ub32ref/le buffer (+ index 4)) upper

          (ub32ref/le buffer index) lower)

    (setf (ub32ref/le vector (+ index 4)) upper

          (ub32ref/le vector index) lower)

    value)

  #-(or sbcl cmu ccl)

  (not-supported))
 
 No newline at end of file