Add buffering.
[iolib.git] / io.streams / zeta / internal.lisp
blobdba418311ac0afbcdbf2849ca1c261cfff5b35c0
1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; --- Foreign memory buffers.
4 ;;;
6 (in-package :io.zeta-streams)
8 (declaim (optimize speed))
10 ;;;; Foreign Buffers
12 (define-constant +default-iobuf-size+ 4096)
14 ;;; almost 128 MB: large enough for a stream buffer,
15 ;;; but small enough to fit into a fixnum
16 (deftype iobuf-index () '(unsigned-byte 27))
17 (deftype iobuf-length () '(integer 0 #.(expt 2 27)))
19 (deftype iobuf-buffer () 'ub8-sarray)
21 (defparameter *empty-array* (make-array 0 :element-type 'ub8))
23 (defstruct (iobuf (:constructor %make-iobuf ()))
24 (data *empty-array* :type iobuf-buffer)
25 (start 0 :type iobuf-index)
26 (end 0 :type iobuf-index))
28 (defun make-iobuf (&optional size)
29 (declare (type (or null iobuf-index) size))
30 (let ((b (%make-iobuf)))
31 (setf (iobuf-data b) (make-array (or size +default-iobuf-size+)
32 :element-type 'ub8
33 :initial-element 0))
34 (values b)))
36 (defun iobuf-size (iobuf)
37 (declare (type iobuf iobuf))
38 (length (iobuf-data iobuf)))
40 (defun iobuf-available-octets (iobuf)
41 (declare (type iobuf iobuf))
42 (- (iobuf-end iobuf)
43 (iobuf-start iobuf)))
45 (defun iobuf-empty-p (iobuf)
46 (declare (type iobuf iobuf))
47 (= (iobuf-start iobuf)
48 (iobuf-end iobuf)))
50 (defun iobuf-reset (iobuf)
51 (declare (type iobuf iobuf))
52 (setf (iobuf-start iobuf) 0
53 (iobuf-end iobuf) 0))
56 ;;;
57 ;;; UNSAFE functions which *DO NOT* check boundaries
58 ;;; that must be done by their callers
59 ;;;
61 (defun bref (iobuf index)
62 (declare (type iobuf iobuf)
63 (type iobuf-index index))
64 (aref (iobuf-data iobuf) index))
66 (defun (setf bref) (octet iobuf index)
67 (declare (type ub8 octet)
68 (type iobuf iobuf)
69 (type iobuf-index index))
70 (setf (aref (iobuf-data iobuf) index) octet))
72 (defun iobuf-pop-octet (iobuf)
73 (declare (type iobuf iobuf))
74 (let ((start (iobuf-start iobuf)))
75 (prog1 (bref iobuf start)
76 (incf (iobuf-start iobuf)))))
78 (defun iobuf-push-octet (iobuf octet)
79 (declare (type iobuf iobuf)
80 (type ub8 octet))
81 (let ((end (iobuf-end iobuf)))
82 (prog1 (setf (bref iobuf end) octet)
83 (incf (iobuf-end iobuf)))))
85 (defun replace-ub8 (destination source start1 end1 start2 end2)
86 (declare (type iobuf-buffer destination source)
87 (type iobuf-index start1 start2 end1 end2))
88 (let ((nbytes (min (- end1 start1)
89 (- end2 start2))))
90 (replace destination source
91 :start1 start1 :end1 end1
92 :start2 start2 :end2 end2)
93 (values destination nbytes)))
95 (defun iobuf->array (array iobuf start end)
96 (declare (type iobuf-buffer array)
97 (type iobuf iobuf)
98 (type iobuf-index start end))
99 (let ((nbytes
100 (nth-value 1 (replace-ub8 array (iobuf-data iobuf)
101 start end
102 (iobuf-start iobuf)
103 (iobuf-end iobuf)))))
104 (incf (iobuf-start iobuf) nbytes)
105 (values nbytes)))
107 (defun array->iobuf (iobuf array start end)
108 (declare (type iobuf-buffer array)
109 (type iobuf iobuf)
110 (type iobuf-index start end))
111 (let ((nbytes
112 (nth-value 1 (replace-ub8 (iobuf-data iobuf) array
113 (iobuf-start iobuf)
114 (iobuf-end iobuf)
115 start end))))
116 (incf (iobuf-end iobuf) nbytes)
117 (values nbytes)))