/[de-setf-amqp]/extremely-simple-stream.lisp
ViewVC logotype

Contents of /extremely-simple-stream.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations)
Tue Feb 23 09:05:39 2010 UTC (4 years, 1 month ago) by janderson
File size: 6502 byte(s)
Merge commit 'remotes/github/master' into remotes/git-svn
1 ;;; -*- Package: de.setf.amqp.implementation; -*-
2
3 (in-package :de.setf.amqp.implementation)
4
5 (document :file
6 (description "This file defines defines the absolutely minimal `simple-stream` class for the
7 'de.setf.amqp' library.")
8 (copyright
9 "Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
10 "'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
11 of the GNU Affero General Public License as published by the Free Software Foundation.
12
13 'setf.amqp' is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
14 implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15 See the Affero General Public License for more details.
16
17 A copy of the GNU Affero General Public License should be included with 'de.setf.amqp' as `AMQP:agpl.txt`.
18 If not, see the GNU [site](http://www.gnu.org/licenses/).")
19
20 (long-description "This defines enough of the simple sream framework to implement connection operators
21 compatible with simple streams. The classes derive from the sbcl port mostly by deleting things."))
22
23
24 (when (intersection '(:allegro :sbcl) *features*)
25 ;; this cannot be permitted as it conflicts with extant definitions
26 (error "DO NOT load this into a runtime which implements simple-streams."))
27
28
29 (deftype simple-stream-buffer () '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)))
30
31 (defmacro add-stream-instance-flags (stream &rest flags)
32 "In this emulated setting, there's nothing happening here."
33 (declare (ignore stream flags))
34 (values))
35
36 ;; define the basic simple-streams device interface
37
38 (defgeneric device-open (stream slots initargs)
39 (:documentation "Make the connection between the stream structure and the
40 actual device being opened, if appropriate, and completes the initialization
41 of the stream structure adequately enough to perform operations on the
42 stream."))
43
44 (defgeneric device-close (stream abort)
45 (:documentation "Breaks the connection to the device and resets internal
46 state to mark the stream as closed and preclude its use from standard i/o
47 operations."))
48
49 (defgeneric device-buffer-length (stream)
50 (:documentation "Returns the desired length of buffers to be allocated for
51 the stream, if any."))
52
53 (defgeneric device-file-position (stream))
54
55 (defgeneric (setf device-file-position) (value stream))
56
57 (defgeneric device-file-length (stream))
58
59 (defgeneric device-read (stream buffer start end blocking))
60
61 (defgeneric device-clear-input (stream buffer-only))
62
63 (defgeneric device-write (stream buffer start end blocking))
64
65 (defgeneric device-clear-output (stream))
66
67 (defgeneric device-finish-record (stream blocking action))
68
69
70 ;; plus, the alternative fu interface
71
72 (defgeneric device-allocate-buffer (stream &key length initial-contents)
73 )
74
75 (defgeneric device-input-element-type (stream)
76 )
77
78 (defgeneric device-output-element-type (stream)
79 )
80
81 (defgeneric device-encoded-length (stream buffer &optional start end)
82 )
83
84 (defgeneric device-write-buffers (stream &rest args)
85 )
86
87 (defgeneric device-read-buffers (stream &rest args)
88 )
89
90
91 ;; add a flag to indicate whether to pad the content body since this is
92 ;; independent of closing the channel/stream
93 (defgeneric device-flush (stream &optional complete)
94 )
95
96 ;; the essential classes are the simple stream classitself and the
97 ;; socket stream specializations. these are excerpted from the sbcl port
98
99 (defclass simple-stream (stream)
100 ((plist
101 :initform nil :type list
102 :accessor stream-plist)
103 (external-format
104 :initarg :external-format
105 :accessor stream-external-format
106 :documentation "The external format is used to decide character
107 data encodings for content only.")
108 (input-handle
109 :initform nil :initarg :input-handle :type (or null stream)
110 :accessor stream-input-handle
111 :documentation "Bound to the socket's stream while open.")
112 (output-handle
113 :initform nil :initarg :output-handle :type (or null stream)
114 :accessor stream-output-handle
115 :documentation "Bound to the same value as input-handle.")
116
117 (buffer
118 :initform nil :type (or simple-stream-buffer null)
119 :reader stream-buffer :writer set-stream-buffer
120 :documentation "This is the buffer used most recently for i/o.
121 It is initialized and maintained by specialized classes.")
122 (buffpos
123 :initform 0 :type fixnum
124 :documentation "The position resulting from the last operation:
125 on input the next byte to get.
126 on output the next postiion to store.")
127 (buffer-ptr
128 :initform 0 :type fixnum
129 :documentation "Maximum valid position in buffer, or -1 on eof.
130 on input, after the last read byte.
131 on output, the length of the byffer.")
132 (buf-len
133 :initform 0 :type fixnum
134 :documentation "The (usable) length of the buffer.")
135 (pending :initform nil :type list))
136
137 (:default-initargs :external-format :default)
138
139 (:documentation "This simple-stream definition provides the minimal support
140 for the connection implemention to act as if there were a complete simple-stream
141 implementation."))
142
143 (defmethod device-file-position ((stream simple-stream))
144 (with-slots (buffpos) stream
145 buffpos))
146
147 (defmethod (setf device-file-position) ((value integer) (stream simple-stream))
148 (with-slots (buffpos) stream
149 (setf buffpos value)))
150
151 (defmethod device-file-length ((stream simple-stream))
152 nil)
153
154 (defclass dual-channel-simple-stream (simple-stream)
155 (;; Output buffer.
156 (out-buffer :initform nil :type (or simple-stream-buffer null))
157 ;; Current position in output buffer.
158 (outpos :initform 0 :type fixnum)
159 ;; Buffer length (one greater than maximum output buffer index)
160 (max-out-pos :initform 0 :type fixnum)))
161
162 (defclass socket-simple-stream (dual-channel-simple-stream)
163 (;; keep the socket around; it could be handy e.g. for querying peer
164 ;; host/port
165 (socket
166 :initform nil :initarg :socket
167 :type (or usocket:stream-usocket null))))
168
169
170 (defmethod shared-initialize :after ((instance simple-stream) slot-names
171 &rest initargs &key &allow-other-keys)
172 (unless (device-open instance slot-names initargs)
173 (device-close instance t)))
174
175
176 ;;; as per the gray interface, close is replaced with a generic function.
177 ;;; in an implmentation which supports simple streams, the simple-stream method delegates to device-close
178 ;;;
179 (when (typep #'close 'generic-function)
180 (defmethod close ((stream simple-stream) &key abort)
181 (device-close stream abort)))

  ViewVC Help
Powered by ViewVC 1.1.5