Commit 53c94519 authored by Zach Beane's avatar Zach Beane
Browse files

More streams updates.

parent b71c650a
...@@ -247,10 +247,26 @@ values otherwise." ...@@ -247,10 +247,26 @@ values otherwise."
(defgeneric excl:device-close (stream abort)) (defgeneric excl:device-close (stream abort))
(defgeneric excl:device-read (stream buffer start end blocking)) (defgeneric excl:device-read (stream buffer start end blocking))
(defgeneric excl:device-write (stream buffer start end blocking)) (defgeneric excl:device-write (stream buffer start end blocking))
(defgeneric excl:install-single-channel-character-strategy (stream format &optional default)
(:method (stream format &optional default)
(declare (ignore stream format default))))
(defvar excl::*std-control-out-table* nil) (defvar excl::*std-control-out-table* nil)
(defclass excl:single-channel-simple-stream (fundamental-stream) (defclass zacl-simple-stream (fundamental-binary-output-stream
fundamental-binary-input-stream)
())
(defmethod stream-write-char ((stream zacl-simple-stream) char)
(let ((buffer (string-to-octets (string char))))
(excl:device-write stream buffer 0 (length buffer) nil)))
(defmethod stream-write-byte ((stream zacl-simple-stream) byte)
(let ((buffer (make-array 1 :element-type '(unsigned-byte 8)
:initial-element byte)))
(excl:device-write stream buffer 0 1 nil)))
(defclass excl:single-channel-simple-stream (zacl-simple-stream)
((excl::buffer ((excl::buffer
:initform (make-array 1024 :element-type '(unsigned-byte 8))) :initform (make-array 1024 :element-type '(unsigned-byte 8)))
(excl::output-handle (excl::output-handle
...@@ -259,6 +275,7 @@ values otherwise." ...@@ -259,6 +275,7 @@ values otherwise."
:initarg :input-handle) :initarg :input-handle)
(excl::buffer-ptr) (excl::buffer-ptr)
(excl::control-out) (excl::control-out)
(excl::oc-state)
(external-format (external-format
:initarg :external-format :initarg :external-format
:initform :default :initform :default
...@@ -270,6 +287,11 @@ values otherwise." ...@@ -270,6 +287,11 @@ values otherwise."
&rest initargs &key &allow-other-keys) &rest initargs &key &allow-other-keys)
(excl:device-open stream slot-names initargs)) (excl:device-open stream slot-names initargs))
(defmethod close ((stream excl:single-channel-simple-stream) &key abort)
(excl:device-close stream abort))
(defgeneric underlying-output-stream (stream) (defgeneric underlying-output-stream (stream)
(:method ((stream excl:single-channel-simple-stream)) (:method ((stream excl:single-channel-simple-stream))
(underlying-output-stream (slot-value stream 'excl::output-handle))) (underlying-output-stream (slot-value stream 'excl::output-handle)))
...@@ -288,12 +310,11 @@ values otherwise." ...@@ -288,12 +310,11 @@ values otherwise."
(:method ((stream stream)) (:method ((stream stream))
stream)) stream))
(defmethod stream-write-string ((stream excl:single-channel-simple-stream) string &optional start end ) (defmethod stream-write-string ((stream excl:single-channel-simple-stream) string &optional start end)
(unless start (setf start 0)) (unless start (setf start 0))
(unless end (setf end (length string))) (unless end (setf end (length string)))
(write-string string (underlying-output-stream stream) (let ((buffer (string-to-octets string :start start :end end)))
:start start (excl:device-write stream buffer 0 (length buffer) nil)))
:end end))
(defmethod ccl:stream-write-vector ((stream excl:single-channel-simple-stream) sequence start end) (defmethod ccl:stream-write-vector ((stream excl:single-channel-simple-stream) sequence start end)
(unless start (setf start 0)) (unless start (setf start 0))
...@@ -322,6 +343,8 @@ values otherwise." ...@@ -322,6 +343,8 @@ values otherwise."
(defun excl:write-vector (vector stream &key (start 0) (end (length vector))) (defun excl:write-vector (vector stream &key (start 0) (end (length vector)))
;; The real write-vector has more complicated blocking ;; The real write-vector has more complicated blocking
;; behavior. Save that for later. ;; behavior. Save that for later.
(when (stringp vector)
(setf vector (string-to-octets vector :start start :end end)))
(write-sequence vector stream :start start :end end) (write-sequence vector stream :start start :end end)
end) end)
......
...@@ -70,6 +70,7 @@ ...@@ -70,6 +70,7 @@
#:fundamental-character-input-stream #:fundamental-character-input-stream
#:stream-read-char #:stream-read-char
#:stream-write-char #:stream-write-char
#:stream-write-byte
#:stream-write-string #:stream-write-string
#:stream-write-sequence #:stream-write-sequence
#:stream-read-byte #:stream-read-byte
...@@ -134,6 +135,7 @@ ...@@ -134,6 +135,7 @@
(:export #:pop-atomic (:export #:pop-atomic
#:push-atomic #:push-atomic
#:single-channel-simple-stream #:single-channel-simple-stream
#:install-single-channel-character-strategy
#:device-open #:device-open
#:device-close #:device-close
#:device-read #:device-read
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment