sockets/buffer.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;   This code is free software; you can redistribute it and/or
   4 ;;   modify it under the terms of the version 2.1 of
   5 ;;   the GNU Lesser General Public License as published by
   6 ;;   the Free Software Foundation, as clarified by the
   7 ;;   preamble found here:
   8 ;;       http://opensource.franz.com/preamble.html
   9 ;;
  10 ;;   This program is distributed in the hope that it will be useful,
  11 ;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;   GNU General Public License for more details.
  14 ;;
  15 ;;   You should have received a copy of the GNU Lesser General
  16 ;;   Public License along with this library; if not, write to the
  17 ;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  18 ;;   Boston, MA 02110-1301, USA
  19
  20 (in-package :net.sockets)
  21
  22 ;;;
  23 ;;; Foreign Buffers
  24 ;;;
  25
  26 (iolib-utils:define-constant +bytes-per-iobuf+ (* 4 1024))
  27
  28 ;; FIXME: make this right
  29 ;; probably not all SIMPLE-ARRAYs are admissible
  30 ;; on all implementations
  31 (deftype compatible-lisp-array ()
  32   '(simple-array * (*)))
  33
  34 (declaim (inline allocate-iobuf free-iobuf
  35                  bref (setf bref) iobuf-copy
  36                  pop-byte push-byte))
  37
  38 (defun allocate-iobuf (&optional (size +bytes-per-iobuf+))
  39   (let ((b (%make-iobuf)))
  40     (setf (iobuf-data b) (cffi:foreign-alloc :uint8 :count size)
  41           (iobuf-size b) size)
  42     (values b)))
  43
  44 (defun free-iobuf (iobuf)
  45   (cffi:foreign-free (iobuf-data iobuf))
  46   (setf (iobuf-data iobuf) (cffi:null-pointer))
  47   (values iobuf))
  48
  49 (defun iobuf-length (iobuf)
  50   (- (iobuf-end iobuf)
  51      (iobuf-start iobuf)))
  52
  53 (defun iobuf-end-space-length (iobuf)
  54   (- (iobuf-size iobuf)
  55      (iobuf-end iobuf)))
  56
  57 (defun iobuf-reset (iobuf)
  58   (setf (iobuf-start iobuf) 0
  59         (iobuf-end iobuf) 0))
  60
  61 (defun iobuf-copy-data-to-start (iobuf)
  62   (declare (type iobuf iobuf))
  63   (et:memmove (iobuf-data iobuf)
  64               (cffi:inc-pointer (iobuf-data iobuf)
  65                                 (iobuf-start iobuf))
  66               (iobuf-length iobuf)))
  67
  68 ;; BREF, (SETF BREF) and BUFFER-COPY *DO NOT* check boundaries
  69 ;; that must be done in their callers
  70 (defun bref (iobuf index)
  71   (declare (type iobuf iobuf)
  72            (type buffer-index index))
  73   (cffi:mem-aref (iobuf-data iobuf) :uint8 index))
  74
  75 (defun (setf bref) (octet iobuf index)
  76   (declare (type (unsigned-byte 8) octet)
  77            (type iobuf iobuf)
  78            (type buffer-index index))
  79   (setf (cffi:mem-aref (iobuf-data iobuf) :uint8 index) octet))
  80
  81 (defun iobuf-copy (src soff dst doff length)
  82   (declare (type compatible-lisp-array src)
  83            (type iobuf dst)
  84            (type fixnum soff doff length))
  85   (let ((dst-ptr (iobuf-data dst)))
  86     (cffi:with-pointer-to-vector-data (src-ptr src)
  87       (cffi:incf-pointer src-ptr soff)
  88       (cffi:incf-pointer dst-ptr doff)
  89       (et:memmove dst-ptr src-ptr length)
  90       (incf (iobuf-end dst) length))))
  91
  92 (defun pop-byte (iobuf)
  93   (declare (type iobuf iobuf))
  94   (let ((length (iobuf-length iobuf)))
  95     (unless (>= length (iobuf-size iobuf))
  96       (prog1 (bref iobuf length)
  97         (incf (iobuf-end iobuf))))))
  98
  99 (defun push-byte (iobuf byte)
 100   (declare (type iobuf iobuf))
 101   (let ((length (iobuf-length iobuf)))
 102     (unless (>= length (iobuf-size iobuf))
 103       (prog1 (setf (bref iobuf length) byte)
 104         (incf (iobuf-end iobuf))))))
 105 \f
 106 ;;;
 107 ;;; Buffer Pool
 108 ;;;
 109
 110 (defstruct (iobuf-pool
 111              (:constructor make-iobuf-pool ())
 112              (:copier nil))
 113   (iobufs nil :type list)
 114   (count  0   :type unsigned-byte))
 115
 116 (defvar *available-iobufs* (make-iobuf-pool))
 117
 118 ;; #-clisp
 119 ;; (defvar *iobuf-lock* (bordeaux-threads:make-lock "NET.SOCKETS STREAMS BUFFER POOL LOCK"))
 120
 121 ;; FIXME: using a lock-free queue would be better
 122 (defun next-available-iobuf ()
 123 ;;   #-clisp
 124 ;;   (bordeaux-threads:with-lock-held (*iobuf-lock*)
 125 ;;     (if (iobuf-pool-iobufs *available-iobufs*)
 126 ;;         (progn
 127 ;;           (pop (iobuf-pool-iobufs *available-iobufs*))
 128 ;;           (decf (iobuf-pool-count *available-iobufs*)))
 129 ;;         (%make-iobuf)))
 130 ;;   #+clisp
 131   (if (iobuf-pool-iobufs *available-iobufs*)
 132       (progn
 133         (pop (iobuf-pool-iobufs *available-iobufs*))
 134         (decf (iobuf-pool-count *available-iobufs*)))
 135       (%make-iobuf)))