[cffi-devel] Shareable Byte Vectors for SBCL

[Faré]

Here's a code snippet I've used in my patch to sb-bsd-sockets, that
implements something similar to your "Shareable Byte Vectors" for
SBCL. Tested with recvfrom and sendto.

[ François-René ÐVB Rideau | Reflection&Cybernethics | http://fare.tunes.org ]
The ultimate result of shielding men from the effects of folly is
to fill the world with fools. -- Herbert Spencer

;;; This little protocol could and should be used in a whole lot of
I/O functions.
;;; It silently assumes that buffers are big enough to fit the length required,
;;; and are either subtypes of characters or integer, and that data will fit.
(deftype iobuffer () "buffer for direct I/O"
  '(simple-array (unsigned-byte 8) (*)))
(defun iobufferp (x) "check if X is a proper iobuffer"
  (typep x '(iobuffer)))
(defun iobuffer-to-data (buffer data &optional (length (length buffer)))
  "copy contents of iobuffer to data array"
  (if (subtypep (array-element-type data) 'integer)
      (replace data buffer :end1 length)
      (loop for i from 0 below length
            do (setf (char data i) (code-char (aref buffer i))))))
(defun data-to-iobuffer (data buffer &optional (length (length data)))
  "copy contents of data array to iobuffer"
  (if (subtypep (array-element-type data) 'integer)
      (replace buffer data :end1 length)
      (loop for i from 0 below length
            do (setf (aref buffer i) (char-code (char data i))))))
(defun ensure-iobuffer-from-data (data &optional (length (length data)))
  "if data is not an iobuffer already, create a new one with similar contents"
  (if (iobufferp data)
      data
      (let ((buffer (make-array (list length) :element-type
'(unsigned-byte 8))))
        (data-to-iobuffer data buffer length)
        buffer)))
(defun prepare-iobuffer-for-data (data &optional length)
  "if data is not an iobuffer already, create a new one with same length"
  (if (iobufferp data)
      data
      (make-array (list length) :element-type '(unsigned-byte 8))))
(defun commit-iobuffer-to-data (buffer data &optional length)
  "if data is not an iobuffer already, replace its contents with
those of given buffer"
  (unless (eq buffer data)
    (iobuffer-to-data buffer data length)))
(defmacro with-iobuffer-sap ((buffer data &key (direction :input)
length) &body body)
  "bind buffer with an iobuffer suitable for I/O of given direction,
to be committed to/from the contents of data array data"
  (let ((data-tn (gensym)) (length-tn (gensym)))
  `(let* ((,data-tn ,data) (,length-tn ,length)
          (,buffer (ecase ,direction
                     (:input (prepare-iobuffer-for-data ,data-tn ,length-tn))
                     ((:output :io) (ensure-iobuffer-from-data
,data-tn ,length-tn)))))
    (prog1
        (sb-sys:with-pinned-objects (,buffer)
          (let ((,buffer (sb-sys:vector-sap ,buffer)))
            , at body))
      (case ,direction
        ((:input :io) (commit-iobuffer-to-data ,buffer ,data-tn
,length-tn)))))))
;;; Should I add a :start argument for the data?
;;; Have :start and :end instead of :start and :length?