io.streams/classes.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;   Copyright (C) 2006, 2007 Stelian Ionescu
   4 ;;
   5 ;;   This code is free software; you can redistribute it and/or
   6 ;;   modify it under the terms of the version 2.1 of
   7 ;;   the GNU Lesser General Public License as published by
   8 ;;   the Free Software Foundation, as clarified by the
   9 ;;   preamble found here:
  10 ;;       http://opensource.franz.com/preamble.html
  11 ;;
  12 ;;   This program is distributed in the hope that it will be useful,
  13 ;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;   GNU General Public License for more details.
  16 ;;
  17 ;;   You should have received a copy of the GNU Lesser General
  18 ;;   Public License along with this library; if not, write to the
  19 ;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  20 ;;   Boston, MA 02110-1301, USA
  21
  22 (in-package :io.streams)
  23
  24 ;;;;;;;;;;;;;
  25 ;;;       ;;;
  26 ;;; Types ;;;
  27 ;;;       ;;;
  28 ;;;;;;;;;;;;;
  29
  30 (deftype ub8  () `(unsigned-byte 8))
  31 (deftype ub16 () `(unsigned-byte 16))
  32 (deftype ub32 () `(unsigned-byte 32))
  33 (deftype sb8  () `(signed-byte 8))
  34 (deftype sb16 () `(signed-byte 16))
  35 (deftype sb32 () `(signed-byte 32))
  36
  37 (deftype ub8-sarray (&optional (size '*))
  38   `(simple-array ub8 (,size)))
  39 (deftype ub8-vector ()
  40   '(vector ub8))
  41 (deftype ub16-sarray (&optional (size '*))
  42   `(simple-array ub16 (,size)))
  43 \f
  44
  45 ;;;;;;;;;;;;;;;;;;;;;;
  46 ;;;                ;;;
  47 ;;; Socket buffers ;;;
  48 ;;;                ;;;
  49 ;;;;;;;;;;;;;;;;;;;;;;
  50
  51 (deftype stream-buffer ()
  52   'et:foreign-pointer)
  53
  54 (deftype buffer-index ()
  55   '(unsigned-byte 24))
  56
  57 (defstruct (iobuf
  58              (:constructor %make-iobuf ()))
  59   (data (null-pointer) :type stream-buffer)
  60   (size 0 :type buffer-index)
  61   (start 0 :type buffer-index)
  62   (end 0 :type buffer-index))
  63
  64 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  65 ;;;                        ;;;
  66 ;;; File-Descriptor Mixins ;;;
  67 ;;;                        ;;;
  68 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  69
  70 (deftype stream-position ()
  71   '(unsigned-byte 64))
  72
  73 (defclass dual-channel-fd-stream-mixin ()
  74   ((input-fd  :initform nil :accessor input-fd-of)
  75    (output-fd :initform nil :accessor output-fd-of)))
  76
  77 (defgeneric input-fd-non-blocking (socket))
  78 (defgeneric (setf input-fd-non-blocking) (mode fd-mixin))
  79
  80 (defgeneric output-fd-non-blocking (socket))
  81 (defgeneric (setf output-fd-non-blocking) (mode fd-mixin))
  82
  83
  84 (defclass dual-channel-single-fd-stream-mixin (dual-channel-fd-stream-mixin) ())
  85
  86 (defgeneric fd-of (stream)
  87   (:method ((stream dual-channel-single-fd-stream-mixin))
  88     (with-accessors ((fd-in  input-fd-of)
  89                      (fd-out output-fd-of)) stream
  90       (assert (eql fd-in fd-out))
  91       (values fd-in))))
  92 (defgeneric (setf fd-of) (fd stream)
  93   (:method (fd (stream dual-channel-single-fd-stream-mixin))
  94     (with-accessors ((fd-in  input-fd-of)
  95                      (fd-out output-fd-of)) stream
  96       (assert (eql fd-in fd-out))
  97       (setf fd-in fd fd-out fd)
  98       (values fd-in))))
  99
 100 (defgeneric fd-non-blocking (socket))
 101 (defgeneric (setf fd-non-blocking) (mode fd-mixin))
 102
 103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 104 ;;;                             ;;;
 105 ;;; Bivalent socket Gray stream ;;;
 106 ;;;                             ;;;
 107 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 108
 109 (defclass dual-channel-gray-stream (dual-channel-fd-stream-mixin
 110                                     fundamental-binary-input-stream
 111                                     fundamental-binary-output-stream
 112                                     fundamental-character-input-stream
 113                                     fundamental-character-output-stream)
 114   ((external-format :initform (find-external-format :default)
 115                     :accessor external-format-of)
 116    ;; Input buffer.
 117    (input-buffer :initform nil :type (or iobuf null)
 118                  :accessor input-buffer-of)
 119    ;; Output buffer.
 120    (output-buffer :initform nil :type (or iobuf null)
 121                   :accessor output-buffer-of)
 122    ;; Flag used by stream-force-output
 123    (must-flush-output :initform nil :type boolean
 124                       :accessor must-flush-output-p)
 125    ;; Last read char buffer index
 126    (ibuf-unread-index :initform 0 :type buffer-index
 127                       :accessor ibuf-unread-index-of)))