+
+;;; simple-stream, dual-channel-simple-stream,
+;;; single-channel-simple-stream
+
+(defmethod device-buffer-length ((stream simple-stream))
+ 4096)
+
+(defmethod device-file-position ((stream simple-stream))
+ (with-stream-class (simple-stream stream)
+ (cond ((any-stream-instance-flags stream :dual)
+ (with-stream-class (dual-channel-simple-stream stream)
+ (sm buffpos stream)))
+ ((any-stream-instance-flags stream :string)
+ (with-stream-class (string-simple-stream stream)
+ (sm buffpos stream)))
+ (t
+ (with-stream-class (single-channel-simple-stream stream)
+ (sm buffpos stream))))))
+
+
+(defmethod (setf device-file-position) (value (stream simple-stream))
+ (with-stream-class (simple-stream stream)
+ (cond ((any-stream-instance-flags stream :dual)
+ (with-stream-class (dual-channel-simple-stream stream)
+ (setf (sm buffpos stream) value)))
+ ((any-stream-instance-flags stream :string)
+ (with-stream-class (string-simple-stream stream)
+ (setf (sm buffpos stream) value)))
+ (t
+ (with-stream-class (single-channel-simple-stream stream)
+ (setf (sm buffpos stream) value))))))
+
+(defmethod device-file-length ((stream simple-stream))
+ nil)
+
+(defmethod device-read ((stream single-channel-simple-stream) buffer
+ start end blocking)
+ ;; rudi (2003-06-07): this block commented out in Paul Foley's code
+;; (when (and (null buffer) (not (eql start end)))
+;; (with-stream-class (single-channel-simple-stream stream)
+;; (setq buffer (sm buffer stream))
+;; (setq end (sm buf-len stream))))
+ (read-octets stream buffer start end blocking))
+
+(defmethod device-read ((stream dual-channel-simple-stream) buffer
+ start end blocking)
+ (when (null buffer)
+ (with-stream-class (dual-channel-simple-stream stream)
+ (setq buffer (sm buffer stream))
+ (setq end (- (sm buf-len stream) start))))
+ (read-octets stream buffer start end blocking))
+
+(defmethod device-clear-input ((stream simple-stream) buffer-only)
+ (declare (ignore buffer-only))
+ nil)
+
+(defmethod device-write ((stream single-channel-simple-stream) buffer
+ start end blocking)
+ (when (and (null buffer) (not (eql start end)))
+ (with-stream-class (single-channel-simple-stream stream)
+ (setf buffer (sm buffer stream))))
+ (write-octets stream buffer start end blocking))
+
+(defmethod device-write ((stream dual-channel-simple-stream) buffer
+ start end blocking)
+ (when (and (null buffer) (not (eql start end)))
+ (with-stream-class (dual-channel-simple-stream stream)
+ (setf buffer (sm out-buffer stream))))
+ (write-octets stream buffer start end blocking))
+
+(defmethod device-clear-output ((stream simple-stream))
+ nil)
+
+
+;;; Direct-Simple-Stream and Buffer-(Input|Output)-Simple-Stream
+
+(defmethod device-file-length ((stream direct-simple-stream))
+ ;; return buffer length
+ )