+(defmethod device-close ((stream mapped-file-simple-stream) abort)
+ (with-stream-class (mapped-file-simple-stream stream)
+ (when (sm buffer stream)
+ (sb-posix:munmap (sm buffer stream) (sm buf-len stream))
+ (setf (sm buffer stream) nil))
+ (cond (abort
+ ;; remove any FD handler
+ ;; if it has an original name (is this possible for mapped files?)
+ ;; revert the file
+ )
+ (t
+ ;; if there's an original name and delete-original is set (again,
+ ;; is this even possible?), kill the original
+ ))
+ (sb-unix:unix-close (sm input-handle stream)))
+ t)
+
+
+;;; Definition of Null-Simple-Stream
+
+
+(defmethod device-open ((stream null-simple-stream) options)
+ (with-stream-class (null-simple-stream stream)
+ (add-stream-instance-flags stream :simple :input :output)
+ ;;(install-single-channel-character-strategy
+ ;; stream (getf options :external-format :default) nil)
+ (setf (sm j-read-char stream) #'null-read-char
+ (sm j-read-chars stream) #'null-read-chars
+ (sm j-unread-char stream) #'null-unread-char
+ (sm j-write-char stream) #'null-write-char
+ (sm j-write-chars stream) #'null-write-chars
+ (sm j-listen stream) #'null-listen))
+ stream)
+
+
+(defmethod device-buffer-length ((stream null-simple-stream))
+ 256)
+
+(defmethod device-read ((stream null-simple-stream) buffer
+ start end blocking)
+ (declare (ignore buffer start end blocking))
+ -1)
+
+(defmethod device-write ((stream null-simple-stream) buffer
+ start end blocking)
+ (declare (ignore buffer blocking))
+ (- end start))
+
+
+;;; Socket-Simple-Stream and relatives
+
+
+(defmethod device-open ((stream socket-base-simple-stream) options)
+ #| do something |#
+ stream)
+
+(defmethod device-open ((stream socket-simple-stream) options)
+ (with-stream-class (socket-simple-stream stream)
+ (let* ((remote-host (getf options :remote-host))
+ (remote-port (getf options :remote-port))
+ (socket (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream :protocol :tcp)))
+ (setf (sm socket stream) socket)
+ (sb-bsd-sockets:socket-connect socket remote-host remote-port)
+ (let ((fd (sb-bsd-sockets:socket-file-descriptor socket)))
+ ;; Connect stream to socket, ...
+ (setf (sm input-handle stream) fd)
+ (setf (sm output-handle stream) fd)
+ ;; ... and socket to stream.
+ (setf (slot-value socket 'stream) stream)
+ (sb-ext:cancel-finalization socket)
+ (sb-ext:finalize stream
+ (lambda ()
+ (sb-unix:unix-close fd)
+ (format *terminal-io*
+ "~&;;; ** closed socket (fd ~D)~%" fd))))
+ ;; Now frob the stream slots. FIXME: should we handle a
+ ;; :direction arg from output, defaulting to :input only?
+ (add-stream-instance-flags stream :simple :input :output :dual)
+ (unless (sm buffer stream)
+ (let ((length (device-buffer-length stream)))
+ ;; Buffer should be array of (unsigned-byte 8), in general
+ ;; use strings for now so it's easy to read the content...
+ (setf (sm buffer stream) (make-string length)
+ (sm buffpos stream) 0
+ (sm buffer-ptr stream) 0
+ (sm buf-len stream) length)))
+ (unless (sm out-buffer stream)
+ (let ((length (device-buffer-length stream)))
+ (setf (sm out-buffer stream) (make-string length)
+ (sm max-out-pos stream) length)))
+ (setf (sm control-in stream) *terminal-control-in-table*)
+ (setf (sm control-out stream) *std-control-out-table*)
+ (install-dual-channel-character-strategy
+ stream (getf options :external-format :default)))
+ stream))
+
+(defmethod device-close ((stream socket-simple-stream) abort)
+ ;; Abort argument is handled by :around method on base class
+ (declare (ignore abort))
+ (with-stream-class (socket-simple-stream stream)
+ (sb-unix:unix-close (sm input-handle stream))
+ (setf (sm buffer stream) nil)
+ (setf (sm out-buffer stream) nil))
+ (sb-ext:cancel-finalization stream)
+ t)
+
+
+;;; String-Simple-Stream and relatives
+
+
+(defmethod device-file-position ((stream string-simple-stream))
+ ;; get string length (of input or output buffer?)
+ )
+
+(defmethod (setf device-file-position) (value (stream string-simple-stream))
+ ;; set string length (of input or output buffer?)
+ )
+
+(defmethod device-file-length ((stream string-simple-stream))
+ ;; return string length
+ )
+
+(defmethod device-open :before ((stream string-input-simple-stream) options)
+ (with-stream-class (string-input-simple-stream stream)
+ (let ((string (getf options :string)))
+ (when (and string (null (sm buffer stream)))
+ (let ((start (getf options :start))
+ (end (or (getf options :end) (length string))))
+ (setf (sm buffer stream) string
+ (sm buffpos stream) start
+ (sm buffer-ptr stream) end))))
+ (install-string-input-character-strategy stream)
+ (add-stream-instance-flags stream :string :input :simple)))
+
+(defmethod device-open :before ((stream string-output-simple-stream) options)
+ (with-stream-class (string-output-simple-stream stream)
+ (unless (sm out-buffer stream)
+ (let ((string (getf options :string)))
+ (if string
+ (setf (sm out-buffer stream) string
+ (sm max-out-pos stream) (length string))
+ (let ((buflen (max (device-buffer-length stream) 16)))
+ (setf (sm out-buffer stream) (make-string buflen)
+ (sm max-out-pos stream) buflen)))))
+ (unless (sm control-out stream)
+ (setf (sm control-out stream) *std-control-out-table*))
+ (install-string-output-character-strategy stream)
+ (add-stream-instance-flags stream :string :output :simple)))
+
+