Skip to content

Commit bc5d398

Browse files
froydnjfroydnj
committed
add source code and ASDF definition
1 parent fe97446 commit bc5d398

File tree

3 files changed

+343
-0
lines changed

3 files changed

+343
-0
lines changed

‎octet-streams.lisp

Lines changed: 321 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,321 @@
1+
; -*- mode:lisp; indent-tabs-mode: nil -*-
2+
3+
(in-package :trivial-octet-streams)
4+
5+
(deftype index () '(mod #.array-dimension-limit))
6+
(deftype simple-octet-vector (&optional length)
7+
(let ((length (or length '*)))
8+
`(simple-array (unsigned-byte 8) (,length))))
9+
10+
;;; portability definitions
11+
12+
#+cmu
13+
(eval-when (:compile-toplevel :load-toplevel :execute)
14+
(require :gray-streams))
15+
16+
;;; TRIVIAL-GRAY-STREAMS has it, we might as well, too...
17+
#+allegro
18+
(eval-when (:compile-toplevel :load-toplevel :execute)
19+
(unless (fboundp #+(and allegro-version>= (not (version>= 9)))
20+
'stream:stream-write-string
21+
#+(and allegro-version>= (version>= 9))
22+
'excl:stream-write-string)
23+
(require "streamc.fasl")))
24+
25+
(eval-when (:compile-toplevel :load-toplevel :execute)
26+
(defvar *binary-input-stream-class*
27+
(quote
28+
#+lispworks stream:fundamental-binary-input-stream
29+
#+sbcl sb-gray:fundamental-binary-input-stream
30+
#+openmcl gray:fundamental-binary-input-stream
31+
#+cmu ext:fundamental-binary-input-stream
32+
#+allegro excl:fundamental-binary-input-stream
33+
#-(or lispworks sbcl openmcl cmu allegro)
34+
(error "octet streams not supported in this implementation")))
35+
36+
(defvar *binary-output-stream-class*
37+
(quote
38+
#+lispworks stream:fundamental-binary-output-stream
39+
#+sbcl sb-gray:fundamental-binary-output-stream
40+
#+openmcl gray:fundamental-binary-output-stream
41+
#+cmu ext:fundamental-binary-output-stream
42+
#+allegro excl:fundamental-binary-output-stream
43+
#-(or lispworks sbcl openmcl cmu allegro)
44+
(error "octet streams not supported in this implementation")))
45+
46+
;;; FIXME: how to do CMUCL support for this?
47+
(defvar *stream-element-type-function*
48+
(quote
49+
#+lispworks cl:stream-element-type
50+
#+sbcl sb-gray::stream-element-type
51+
#+openmcl cl:stream-element-type
52+
#+cmu cl:stream-element-type
53+
#+allegro cl:stream-element-type
54+
#-(or lispworks sbcl openmcl cmu allegro)
55+
(error "octet streams not supported in this implementation")))
56+
57+
(defvar *stream-read-byte-function*
58+
(quote
59+
#+lispworks stream:stream-read-byte
60+
#+sbcl sb-gray:stream-read-byte
61+
#+openmcl gray:stream-read-byte
62+
#+cmu ext:stream-read-byte
63+
#+allegro excl:stream-read-byte
64+
#-(or lispworks sbcl openmcl cmu allegro)
65+
(error "octet streams not supported in this implementation")))
66+
67+
(defvar *stream-write-byte-function*
68+
(quote
69+
#+lispworks stream:stream-write-byte
70+
#+sbcl sb-gray:stream-write-byte
71+
#+openmcl gray:stream-write-byte
72+
#+cmu ext:stream-write-byte
73+
#+allegro excl:stream-write-byte
74+
#-(or lispworks sbcl openmcl cmu allegro)
75+
(error "octet streams not supported in this implementation")))
76+
77+
(defvar *stream-read-sequence-function*
78+
(quote
79+
#+lispworks stream:stream-read-sequence
80+
#+sbcl sb-gray:stream-read-sequence
81+
#+openmcl ccl:stream-read-vector
82+
#+cmu ext:stream-read-sequence
83+
#+allegro excl:stream-read-sequence
84+
#-(or lispworks sbcl openmcl cmu allegro)
85+
(error "octet streams not supported in this implementation")))
86+
87+
(defvar *stream-write-sequence-function*
88+
(quote
89+
#+lispworks stream:stream-write-sequence
90+
#+sbcl sb-gray:stream-write-sequence
91+
#+openmcl ccl:stream-write-vector
92+
#+cmu ext:stream-write-sequence
93+
#+allegro excl:stream-write-sequence
94+
#-(or lispworks sbcl openmcl cmu allegro)
95+
(error "octet streams not supported in this implementation")))
96+
97+
(defvar *stream-finish-output-function*
98+
(quote
99+
#+lispworks stream:stream-finish-output
100+
#+sbcl sb-gray:stream-finish-output
101+
#+openmcl gray:stream-finish-output
102+
#+cmu ext:stream-finish-output
103+
#+allegro excl:stream-finish-output
104+
#-(or lispworks sbcl openmcl cmu allegro)
105+
(error "octet streams not supported in this implementation")))
106+
107+
(defvar *stream-force-output-function*
108+
(quote
109+
#+lispworks stream:stream-force-output
110+
#+sbcl sb-gray:stream-force-output
111+
#+openmcl gray:stream-force-output
112+
#+cmu ext:stream-force-output
113+
#+allegro excl:stream-force-output
114+
#-(or lispworks sbcl openmcl cmu allegro)
115+
(error "octet streams not supported in this implementation")))
116+
117+
(defvar *stream-clear-output-function*
118+
(quote
119+
#+lispworks stream:stream-clear-output
120+
#+sbcl sb-gray:stream-clear-output
121+
#+openmcl gray:stream-clear-output
122+
#+cmu ext:stream-clear-output
123+
#+allegro excl:stream-clear-output
124+
#-(or lispworks sbcl openmcl cmu allegro)
125+
(error "octet streams not supported in this implementation")))
126+
)
127+
128+
129+
;;; implementation via Gray streams
130+
131+
;;; These could be specialized for particular implementations by hooking
132+
;;; in directly to the "native" stream methods for the implementation.
133+
134+
(defclass octet-stream ()
135+
((buffer :accessor buffer :initarg :buffer :type simple-octet-vector)))
136+
137+
(defmethod #.*stream-element-type-function* ((stream octet-stream))
138+
'(unsigned-byte 8))
139+
140+
(defmacro define-stream-read-sequence (specializer type &body body)
141+
#+sbcl
142+
`(defmethod sb-gray:stream-read-sequence ((stream ,specializer) seq &optional (start 0) end)
143+
(typecase seq
144+
(,type
145+
(let ((end (or end (length seq))))
146+
,@body))
147+
(t
148+
(call-next-method))))
149+
#+cmu
150+
`(defmethod ext:stream-read-sequence ((stream ,specializer) seq &optional (start 0) end)
151+
(typecase seq
152+
(,type
153+
(let ((end (or end (length seq))))
154+
,@body))
155+
(t
156+
(call-next-method))))
157+
#+allegro
158+
`(defmethod excl:stream-read-sequence ((stream ,specializer) seq &optional (start 0) end)
159+
(typecase seq
160+
(,type
161+
(let ((end (or end (length seq))))
162+
,@body))
163+
(t
164+
(call-next-method))))
165+
#+openmcl
166+
`(defmethod ccl:stream-read-vector ((stream ,specializer) seq start end)
167+
(typecase seq
168+
(,type
169+
,@body)
170+
(t
171+
(call-next-method))))
172+
#+lispworks
173+
`(defmethod stream:stream-read-sequence ((stream ,specializer) seq start end)
174+
(typecase seq
175+
(,type
176+
,@body)
177+
(t
178+
(call-next-method)))))
179+
180+
(defmacro define-stream-write-sequence (specializer type &body body)
181+
#+sbcl
182+
`(defmethod sb-gray:stream-write-sequence ((stream ,specializer) seq &optional (start 0) end)
183+
(typecase seq
184+
(,type
185+
(let ((end (or end (length seq))))
186+
,@body))
187+
(t
188+
(call-next-method))))
189+
#+cmu
190+
`(defmethod ext:stream-write-sequence ((stream ,specializer) seq &optional (start 0) end)
191+
(typecase seq
192+
(,type
193+
(let ((end (or end (length seq))))
194+
,@body))
195+
(t
196+
(call-next-method))))
197+
198+
#+allegro
199+
(let ((stream-write-sequence
200+
#+(not allegro-version>=) 'stream:stream-write-sequence
201+
#+(and allegro-version>= (not (version>= 9)))
202+
'stream:stream-write-sequence
203+
#+(and allegro-version>= (version>= 9)) 'excl:stream-write-sequence))
204+
`(defmethod ,stream-write-sequence ((stream ,specializer) seq &optional
205+
(start 0) end)
206+
(typecase seq
207+
(,type
208+
(let ((end (or end (length seq))))
209+
,@body))
210+
(t
211+
(call-next-method)))))
212+
213+
#+openmcl
214+
`(defmethod ccl:stream-write-vector ((stream ,specializer) seq start end)
215+
(typecase seq
216+
(,type
217+
,@body)
218+
(t
219+
(call-next-method))))
220+
#+lispworks
221+
`(defmethod stream:stream-write-sequence ((stream ,specializer) seq start end)
222+
(typecase seq
223+
(,type
224+
,@body)
225+
(t
226+
(call-next-method)))))
227+
228+
;;; input streams
229+
230+
(defclass octet-input-stream (octet-stream #.*binary-input-stream-class*)
231+
((index :accessor index :initarg :index :type index)
232+
(end :accessor end :initarg :end :type index)))
233+
234+
(defmethod #.*stream-read-byte-function* ((stream octet-input-stream))
235+
(let ((buffer (buffer stream))
236+
(index (index stream)))
237+
(declare (type simple-octet-vector buffer))
238+
(cond
239+
((>= index (end stream)) :eof)
240+
(t
241+
(setf (index stream) (1+ index))
242+
(aref buffer index)))))
243+
244+
(define-stream-read-sequence octet-input-stream simple-octet-vector
245+
(let ((buffer (buffer stream))
246+
(index (index stream))
247+
(buffer-end (end stream)))
248+
(declare (type simple-octet-vector buffer))
249+
(let* ((remaining (- buffer-end index))
250+
(length (- end start))
251+
(amount (min remaining length)))
252+
(replace seq buffer :start1 start :end1 end
253+
:start2 index :end2 buffer-end)
254+
(setf (index stream) (+ index amount))
255+
(+ start amount))))
256+
257+
(defun make-octet-input-stream (buffer &optional (start 0) end)
258+
"As MAKE-STRING-INPUT-STREAM, only with octets instead of characters."
259+
(declare (type simple-octet-vector buffer)
260+
(type index start)
261+
(type (or index cl:null) end))
262+
(let ((end (or end (length buffer))))
263+
(make-instance 'octet-input-stream
264+
:buffer buffer :index start :end end)))
265+
266+
267+
;;; output streams
268+
269+
(defclass octet-output-stream (octet-stream #.*binary-output-stream-class*)
270+
((index :accessor index :initform 0 :type index)))
271+
272+
(defmethod #.*stream-write-byte-function* ((stream octet-output-stream) integer)
273+
(declare (type (unsigned-byte 8) integer))
274+
(let* ((buffer (buffer stream))
275+
(length (length buffer))
276+
(index (index stream)))
277+
(declare (type simple-octet-vector buffer))
278+
(when (>= index (length buffer))
279+
(let ((new-buffer (make-array (* 2 length)
280+
:element-type '(unsigned-byte 8))))
281+
(declare (type simple-octet-vector new-buffer))
282+
(replace new-buffer buffer)
283+
(setf buffer new-buffer
284+
(buffer stream) new-buffer)))
285+
(setf (aref buffer index) integer
286+
(index stream) (1+ index))
287+
integer))
288+
289+
(define-stream-write-sequence octet-output-stream simple-octet-vector
290+
(let* ((buffer (buffer stream))
291+
(length (length buffer))
292+
(index (index stream))
293+
(amount (- end start)))
294+
(declare (type simple-octet-vector buffer))
295+
(when (>= (+ index amount) length)
296+
(let ((new-buffer (make-array (* 2 (max amount length))
297+
:element-type '(unsigned-byte 8))))
298+
(declare (type simple-octet-vector new-buffer))
299+
(replace new-buffer buffer)
300+
(setf buffer new-buffer
301+
(buffer stream) new-buffer)))
302+
(replace buffer seq :start1 index :start2 start :end2 end)
303+
(incf (index stream) amount)
304+
seq))
305+
306+
(defmethod #.*stream-clear-output-function* ((stream octet-output-stream))
307+
(setf (index stream) 0)
308+
nil)
309+
310+
(defun get-output-stream-octets (stream)
311+
"As GET-OUTPUT-STREAM-STRING, only with an octet output-stream instead
312+
of a string output-stream."
313+
(let ((buffer (buffer stream))
314+
(index (index stream)))
315+
(setf (index stream) 0)
316+
(subseq buffer 0 index)))
317+
318+
(defun make-octet-output-stream ()
319+
"As MAKE-STRING-OUTPUT-STREAM, only with octets instead of characters."
320+
(make-instance 'octet-output-stream
321+
:buffer (make-array 128 :element-type '(unsigned-byte 8))))

‎package.lisp

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
; -*- mode:lisp; indent-tabs-mode: nil -*-
2+
3+
(cl:defpackage :trivial-octet-streams
4+
(:use :cl)
5+
(:export #:make-octet-input-stream #:make-octet-output-stream
6+
#:get-output-stream-octets))

‎trivial-octet-streams.asd

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
; -*- mode:lisp; indent-tabs-mode: nil -*-
2+
3+
(cl:defpackage :trivial-octet-streams-system
4+
(:use :cl))
5+
6+
(cl:in-package :trivial-octet-streams-system)
7+
8+
(asdf:defsystem :trivial-octet-streams
9+
:version "0.1"
10+
:author "Nathan Froyd <[email protected]>"
11+
:maintainer "Nathan Froyd <[email protected]>"
12+
:description "A library for octet input and output streams analogous to string streams."
13+
:components ((:static-file "README")
14+
(:static-file "LICENSE")
15+
(:file "package")
16+
(:file "octet-streams" :depends-on ("package"))))

0 commit comments

Comments
 (0)