mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
72 lines
2.3 KiB
Common Lisp
72 lines
2.3 KiB
Common Lisp
;;; **********************************************************************
|
|
;;; This code was written by Paul Foley and has been placed in the public
|
|
;;; domain.
|
|
;;;
|
|
|
|
;;; Sbcl port by Rudi Schlatte.
|
|
|
|
(in-package "SB-SIMPLE-STREAMS")
|
|
|
|
;;;
|
|
;;; **********************************************************************
|
|
;;;
|
|
;;; Definition of Null-Simple-Stream
|
|
|
|
(def-stream-class null-simple-stream (single-channel-simple-stream)
|
|
())
|
|
|
|
(declaim (ftype j-read-char-fn null-read-char))
|
|
(defun null-read-char (stream eof-error-p eof-value blocking)
|
|
(declare (ignore blocking))
|
|
(sb-impl::eof-or-lose stream eof-error-p eof-value))
|
|
|
|
(declaim (ftype j-read-chars-fn null-read-chars))
|
|
(defun null-read-chars (stream string search start end blocking)
|
|
(declare (ignore stream string search start end blocking))
|
|
(values 0 :eof))
|
|
|
|
(declaim (ftype j-unread-char-fn null-unread-char))
|
|
(defun null-unread-char (stream relaxed)
|
|
(declare (ignore stream relaxed)))
|
|
|
|
(declaim (ftype j-write-char-fn null-write-char))
|
|
(defun null-write-char (character stream)
|
|
(declare (ignore stream))
|
|
character)
|
|
|
|
(declaim (ftype j-write-chars-fn null-write-chars))
|
|
(defun null-write-chars (string stream start end)
|
|
(declare (ignore string stream))
|
|
(- end start))
|
|
|
|
(declaim (ftype j-listen-fn null-listen))
|
|
(defun null-listen (stream)
|
|
(declare (ignore stream))
|
|
nil)
|
|
|
|
(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))
|