Skip to content
Snippets Groups Projects
Commit 6f10d865 authored by ram's avatar ram
Browse files

Merged systems-work sources as of this date:

.../systems-work/code/stream.lisp, 27-May-90 14:11:17, Edit by Chiles and Wlott.
  Changed the semantics of the :listen misc method for streams.  It now
  distinguishes between eof and no obvious input for other reasons.  This was
  necessary to correctly implement READ-CHAR-NO-HANG.

  LISTEN no tests the result of calling the :listen misc method for being
  explicitly t.  When it is :eof or nil, LISTEN should return nil.

  READ-CHAR-NO-HANG no calls the :listen misc method directly instead of
  calling LISTEN.  When the method returns t or :eof, it calls READ-CHAR to
  appropriately deal with returning the character or screaming because of eof.

  Modified the :listen misc method for concatenated streams.  It failed to step
  to the next stream when the current one hit eof.

  Modified the :listen misc method for string-input stream.  They never return
  nil since they either have more characters, or they are at :eof.


.../code/stream.lisp, 26-Apr-90 18:46:58, Edit by Wlott.
  Make two-way streams force-output on the output side before passing any
  input requests on to the input side.


.../systems-work/code/stream.lisp, 22-Mar-90 22:20:05, Edit by Chiles.
  Made the string-input-stream structure definition no longer specify
  :constructor nil in addition to defining one with a name.
parent 240e9cd7
No related branches found
No related tags found
No related merge requests found
......@@ -7,11 +7,11 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.9 1991/02/08 13:35:53 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.10 1991/02/14 18:47:57 ram Exp $")
;;;
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.9 1991/02/08 13:35:53 ram Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.10 1991/02/14 18:47:57 ram Exp $
;;;
;;; Stream functions for Spice Lisp.
;;; Written by Skef Wholey and Rob MacLachlan.
......@@ -94,7 +94,10 @@
;;; is passed a keyword which indicates the operation to perform.
;;; The following keywords are used:
;;; :read-line - Do a read-line.
;;; :listen - Return true if any input waiting.
;;; :listen - Return the following values:
;;; t if any input waiting.
;;; :eof if at eof.
;;; nil if no input is available and not at eof.
;;; :unread - Unread the character Arg.
;;; :close - Do any stream specific stuff to close the stream.
;;; The methods are set to closed-flame by the close
......@@ -218,6 +221,7 @@
(funcall (stream-misc stream) stream :read-line eof-errorp
eof-value))))
;;; We proclaim them inline here, then proclaim them notinline at EOF,
;;; so, except in this file, they are not inline by default, but they can be.
;;;
......@@ -274,13 +278,18 @@
"Returns T if a character is availible on the given Stream."
(let ((stream (in-synonym-of stream)))
(or (/= (the fixnum (stream-in-index stream)) in-buffer-length)
(funcall (stream-misc stream) stream :listen))))
;; Test for t explicitly since misc methods return :eof sometimes.
(eq (funcall (stream-misc stream) stream :listen) t))))
(defun read-char-no-hang (&optional (stream *standard-input*)
(eof-errorp t) eof-value recursive-p)
"Returns the next character from the Stream if one is availible, or nil."
(declare (ignore recursive-p))
(if (listen stream) (read-char stream eof-errorp eof-value) nil))
(let ((stream (in-synonym-of stream)))
(if (funcall (stream-misc stream) stream :listen)
;; On t or :eof get READ-CHAR to do the work.
(read-char stream eof-errorp eof-value)
nil)))
(defun clear-input (&optional (stream *standard-input*))
"Clears any buffered input associated with the Stream."
......@@ -565,6 +574,7 @@
(macrolet ((in-fun (name fun &rest args)
`(defun ,name (stream ,@args)
(force-output (two-way-stream-output-stream stream))
(,fun (two-way-stream-input-stream stream) ,@args))))
(in-fun two-way-in read-char eof-errorp eof-value)
(in-fun two-way-bin read-byte eof-errorp eof-value)
......@@ -578,7 +588,9 @@
(case operation
(:listen (or (/= (the fixnum (stream-in-index in)) in-buffer-length)
(funcall in-method in :listen)))
(:read-line (read-line in arg1 arg2))
(:read-line
(force-output out)
(read-line in arg1 arg2))
((:finish-output :force-output :clear-output)
(funcall out-method out operation arg1 arg2))
((:clear-input :unread)
......@@ -672,8 +684,24 @@
(let* ((current (car left))
(misc (stream-misc current)))
(case operation
(:listen (or (/= (the fixnum (stream-in-index current)) in-buffer-length)
(funcall misc current :listen)))
(:listen
(loop
(let ((stuff (funcall misc current :listen)))
(cond ((eq stuff :eof)
;; Advance current, and try again.
(pop (concatenated-stream-current stream))
(setf current
(car (concatenated-stream-current stream)))
(unless current
;; No further streams. EOF.
(return :eof))
(setf misc (stream-misc current)))
(stuff
;; Stuff's available.
(return t))
(t
;; Nothing available yet.
(return nil))))))
(:close
(dolist (stream (concatenated-stream-streams stream))
(funcall (stream-misc stream) stream :close arg1))
......@@ -765,7 +793,7 @@
(in #'string-inch)
(misc #'string-in-misc))
(:print-function %print-string-input-stream)
(:constructor nil)
;(:constructor nil)
(:constructor internal-make-string-input-stream
(string current end)))
(string nil :type simple-string)
......@@ -814,8 +842,9 @@
(setf (string-input-stream-current stream) end)
(values result t)))))))
(:unread (decf (string-input-stream-current stream)))
(:listen (not (= (the fixnum (string-input-stream-current stream))
(the fixnum (string-input-stream-end stream)))))
(:listen (or (/= (the fixnum (string-input-stream-current stream))
(the fixnum (string-input-stream-end stream)))
:eof))
(:element-type 'string-char)))
(defun make-string-input-stream (string &optional
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment