/[cmucl]/src/code/stream.lisp
ViewVC logotype

Contents of /src/code/stream.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (hide annotations)
Mon Jun 10 16:57:47 1991 UTC (22 years, 10 months ago) by chiles
Branch: MAIN
Changes since 1.11: +43 -2 lines
Moved EXT:GET-STREAM-COMMAND into this file, so kernel cores could enter the
debugger.
1 ram 1.1 ;;; -*- Log: code.log; Package: Lisp -*-
2     ;;;
3     ;;; **********************************************************************
4 ram 1.9 ;;; This code was written as part of the CMU Common Lisp project at
5     ;;; Carnegie Mellon University, and has been placed in the public domain.
6     ;;; If you want to use this code or any part of CMU Common Lisp, please contact
7     ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
8     ;;;
9     (ext:file-comment
10 chiles 1.12 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/stream.lisp,v 1.12 1991/06/10 16:57:47 chiles Exp $")
11 ram 1.9 ;;;
12 ram 1.1 ;;; **********************************************************************
13     ;;;
14 chiles 1.12 ;;; $Header: /tiger/var/lib/cvsroots/cmucl/src/code/stream.lisp,v 1.12 1991/06/10 16:57:47 chiles Exp $
15 wlott 1.4 ;;;
16 ram 1.1 ;;; Stream functions for Spice Lisp.
17     ;;; Written by Skef Wholey and Rob MacLachlan.
18     ;;;
19     ;;; This file contains the machine-independent stream functions. Another
20     ;;; file (VAXIO, SPIO, or VMIO) contains functions used by this file for
21     ;;; a specific machine.
22     ;;;
23 ram 1.2 (in-package "LISP")
24 ram 1.1
25     (export '(make-broadcast-stream make-synonym-stream
26     make-broadcast-stream make-concatenated-stream make-two-way-stream
27     make-echo-stream make-string-input-stream make-string-output-stream
28     get-output-stream-string stream-element-type input-stream-p
29     output-stream-p close read-line read-char
30     unread-char peek-char listen read-char-no-hang clear-input read-byte
31     write-char write-string write-line terpri fresh-line
32     finish-output force-output clear-output write-byte
33     stream streamp *standard-input* *standard-output*
34     *error-output* *query-io* *debug-io* *terminal-io* *trace-output*))
35    
36     (in-package 'system)
37     (export '(make-indenting-stream read-n-bytes))
38     (in-package 'lisp)
39    
40     ;;;; Standard streams:
41     ;;;
42     ;;; The initialization of these streams is performed by Stream-Init,
43     ;;; which lives in the file of machine-specific stream functions.
44     ;;;
45     (defvar *terminal-io* () "Terminal I/O stream.")
46     (defvar *standard-input* () "Default input stream.")
47     (defvar *standard-output* () "Default output stream.")
48     (defvar *error-output* () "Error output stream.")
49     (defvar *query-io* () "Query I/O stream.")
50     (defvar *trace-output* () "Trace output stream.")
51     (defvar *debug-io* () "Interactive debugging stream.")
52    
53     (defun ill-in (stream &rest ignore)
54     (declare (ignore ignore))
55     (error "~S is not a character input stream." stream))
56     (defun ill-out (stream &rest ignore)
57     (declare (ignore ignore))
58     (error "~S is not a character output stream." stream))
59     (defun ill-bin (stream &rest ignore)
60     (declare (ignore ignore))
61     (error "~S is not a binary input stream." stream))
62     (defun ill-bout (stream &rest ignore)
63     (declare (ignore ignore))
64     (error "~S is not a binary output stream." stream))
65     (defun closed-flame (stream &rest ignore)
66     (declare (ignore ignore))
67     (error "~S is closed." stream))
68     (defun do-nothing (&rest ignore)
69     (declare (ignore ignore)))
70    
71     (defun %print-stream (structure stream d)
72     (declare (ignore d structure))
73     (write-string "#<Bare Stream>" stream))
74    
75     ;;; HOW THE STREAM STRUCTURE IS USED:
76     ;;;
77     ;;; Many of the slots of the stream structure contain functions
78     ;;; which are called to perform some operation on the stream. Closed
79     ;;; streams have #'Closed-Flame in all of their function slots. If
80     ;;; one side of an I/O or echo stream is closed, the whole stream is
81     ;;; considered closed. The functions in the operation slots take
82     ;;; arguments as follows:
83     ;;;
84     ;;; In: Stream, Eof-Errorp, Eof-Value
85     ;;; Bin: Stream, Eof-Errorp, Eof-Value
86     ;;; N-Bin: Stream, Buffer, Start, Numbytes, Eof-Errorp
87     ;;; Out: Stream, Character
88     ;;; Bout: Stream, Integer
89     ;;; Sout: Stream, String, Start, End
90     ;;; Misc: Stream, Operation, &Optional Arg1, Arg2
91     ;;;
92     ;;; In order to save space, some of the less common stream operations
93     ;;; are handled by just one function, the Misc method. This function
94     ;;; is passed a keyword which indicates the operation to perform.
95     ;;; The following keywords are used:
96     ;;; :read-line - Do a read-line.
97 ram 1.10 ;;; :listen - Return the following values:
98     ;;; t if any input waiting.
99     ;;; :eof if at eof.
100     ;;; nil if no input is available and not at eof.
101 ram 1.1 ;;; :unread - Unread the character Arg.
102     ;;; :close - Do any stream specific stuff to close the stream.
103     ;;; The methods are set to closed-flame by the close
104     ;;; function, so that need not be done by this
105     ;;; function.
106     ;;; :clear-input - Clear any unread input
107     ;;; :finish-output,
108     ;;; :force-output - Cause output to happen
109     ;;; :clear-output - Clear any undone output
110     ;;; :element-type - Return the type of element the stream deals with.
111     ;;; :line-length - Return the length of a line of output.
112     ;;; :charpos - Return current output position on the line.
113     ;;; :file-length - Return the file length of a file stream.
114     ;;; :file-position - Return or change the current position of a file stream.
115     ;;; :file-name - Return the name of an associated file.
116     ;;;
117     ;;; In order to do almost anything useful, it is necessary to
118     ;;; define a new type of structure that includes stream, so that the
119     ;;; stream can have some state information.
120     ;;;
121     ;;; THE STREAM IN-BUFFER:
122     ;;;
123     ;;; The In-Buffer in the stream holds characters or bytes that
124     ;;; are ready to be read by some input function. If there is any
125     ;;; stuff in the In-Buffer, then the reading function can use it
126     ;;; without calling any stream method. Any stream may put stuff in
127     ;;; the In-Buffer, and may also assume that any input in the In-Buffer
128     ;;; has been consumed before any in-method is called. If a text
129     ;;; stream has in In-Buffer, then the first character should not be
130     ;;; used to buffer normal input so that it is free for unreading into.
131     ;;;
132     ;;; The In-Buffer slot is a vector In-Buffer-Length long. The
133     ;;; In-Index is the index in the In-Buffer of the first available
134     ;;; object. The available objects are thus between In-Index and the
135     ;;; length of the In-Buffer.
136     ;;;
137     ;;; When this buffer is only accessed by the normal stream
138     ;;; functions, the number of function calls is halved, thus
139     ;;; potentially doubling the speed of simple operations. If the
140     ;;; Fast-Read-Char and Fast-Read-Byte macros are used, nearly all
141     ;;; function call overhead is removed, vastly speeding up these
142     ;;; important operations.
143     ;;;
144     ;;; If a stream does not have an In-Buffer, then the In-Buffer slot
145     ;;; must be nil, and the In-Index must be In-Buffer-Length. These are
146     ;;; the default values for the slots.
147    
148     ;;; Stream manipulation functions.
149    
150     (defun input-stream-p (stream)
151     "Returns non-nil if the given Stream can perform input operations."
152     (and (streamp stream)
153     (not (eq (stream-in stream) #'closed-flame))
154     (or (not (eq (stream-in stream) #'ill-in))
155     (not (eq (stream-bin stream) #'ill-bin)))))
156    
157     (defun output-stream-p (stream)
158     "Returns non-nil if the given Stream can perform output operations."
159     (and (streamp stream)
160     (not (eq (stream-in stream) #'closed-flame))
161     (or (not (eq (stream-out stream) #'ill-out))
162     (not (eq (stream-bout stream) #'ill-bout)))))
163    
164     (defun stream-element-type (stream)
165     "Returns a type specifier for the kind of object returned by the Stream."
166     (if (streamp stream)
167     (funcall (stream-misc stream) stream :element-type)
168     (error "~S is not a stream." stream)))
169    
170     (defun close (stream &key abort)
171     "Closes the given Stream. No more I/O may be performed, but inquiries
172     may still be made. If :Abort is non-nil, an attempt is made to clean
173     up the side effects of having created the stream."
174     (if (streamp stream)
175     (unless (eq (stream-in stream) #'closed-flame)
176     (funcall (stream-misc stream) stream :close abort))
177     (error "~S is not a stream." stream))
178     t)
179    
180     (defun set-closed-flame (stream)
181     (setf (stream-in stream) #'closed-flame)
182     (setf (stream-bin stream) #'closed-flame)
183     (setf (stream-n-bin stream) #'closed-flame)
184     (setf (stream-in stream) #'closed-flame)
185     (setf (stream-out stream) #'closed-flame)
186     (setf (stream-bout stream) #'closed-flame)
187     (setf (stream-sout stream) #'closed-flame)
188     (setf (stream-misc stream) #'closed-flame))
189    
190     ;;; Input functions:
191    
192     (defun read-line (&optional (stream *standard-input*) (eof-errorp t) eof-value
193     recursive-p)
194     "Returns a line of text read from the Stream as a string, discarding the
195     newline character."
196     (declare (ignore recursive-p))
197     (let* ((stream (in-synonym-of stream))
198     (buffer (stream-in-buffer stream))
199     (index (stream-in-index stream)))
200     (declare (fixnum index))
201     (if (simple-string-p buffer)
202 wlott 1.4 (let ((nl (%sp-find-character buffer index in-buffer-length
203     #\newline)))
204 ram 1.1 (if nl
205     (values (prog1 (subseq (the simple-string buffer) index nl)
206 wlott 1.4 (setf (stream-in-index stream)
207     (1+ (the fixnum nl))))
208 ram 1.1 nil)
209     (multiple-value-bind (str eofp)
210     (funcall (stream-misc stream) stream
211     :read-line eof-errorp eof-value)
212     (if (= index in-buffer-length)
213     (values str eofp)
214 wlott 1.4 (let ((first (subseq buffer index in-buffer-length)))
215     (setf (stream-in-index stream) in-buffer-length)
216     (if (eq str eof-value)
217     (values first t)
218     (values (concatenate 'simple-string first
219     (the simple-string str))
220     eofp)))))))
221     (funcall (stream-misc stream) stream :read-line eof-errorp
222     eof-value))))
223 ram 1.1
224 ram 1.10
225 ram 1.1 ;;; We proclaim them inline here, then proclaim them notinline at EOF,
226     ;;; so, except in this file, they are not inline by default, but they can be.
227     ;;;
228     (proclaim '(inline read-char unread-char read-byte listen))
229     (defun read-char (&optional (stream *standard-input*) (eof-errorp t) eof-value
230     recursive-p)
231     "Inputs a character from Stream and returns it."
232     (declare (ignore recursive-p))
233     (let* ((stream (in-synonym-of stream))
234     (index (stream-in-index stream)))
235     (declare (fixnum index))
236     (if (eql index in-buffer-length)
237     (funcall (stream-in stream) stream eof-errorp eof-value)
238     (prog1 (aref (stream-in-buffer stream) index)
239     (setf (stream-in-index stream) (1+ index))))))
240    
241     (defun unread-char (character &optional (stream *standard-input*))
242     "Puts the Character back on the front of the input Stream."
243     (let* ((stream (in-synonym-of stream))
244     (index (1- (the fixnum (stream-in-index stream))))
245     (buffer (stream-in-buffer stream)))
246     (declare (fixnum index))
247     (when (minusp index) (error "Nothing to unread."))
248     (if buffer
249     (setf (aref (the simple-array buffer) index) character
250     (stream-in-index stream) index)
251     (funcall (stream-misc stream) stream :unread character)))
252     nil)
253    
254     (defun peek-char (&optional (peek-type nil) (stream *standard-input*)
255     (eof-errorp t) eof-value recursive-p)
256     "Peeks at the next character in the input Stream. See manual for details."
257     (declare (ignore recursive-p))
258     (let* ((stream (in-synonym-of stream))
259     (char (read-char stream eof-errorp eof-value)))
260     (cond ((eq char eof-value) char)
261     ((characterp peek-type)
262     (do ((char char (read-char stream eof-errorp eof-value)))
263     ((or (eq char eof-value) (char= char peek-type))
264     (unless (eq char eof-value)
265     (unread-char char stream))
266     char)))
267     ((eq peek-type t)
268     (do ((char char (read-char stream eof-errorp eof-value)))
269     ((or (eq char eof-value) (not (whitespace-char-p char)))
270     (unless (eq char eof-value)
271     (unread-char char stream))
272     char)))
273     (t
274     (unread-char char stream)
275     char))))
276    
277     (defun listen (&optional (stream *standard-input*))
278     "Returns T if a character is availible on the given Stream."
279     (let ((stream (in-synonym-of stream)))
280     (or (/= (the fixnum (stream-in-index stream)) in-buffer-length)
281 ram 1.10 ;; Test for t explicitly since misc methods return :eof sometimes.
282     (eq (funcall (stream-misc stream) stream :listen) t))))
283 ram 1.1
284     (defun read-char-no-hang (&optional (stream *standard-input*)
285     (eof-errorp t) eof-value recursive-p)
286     "Returns the next character from the Stream if one is availible, or nil."
287     (declare (ignore recursive-p))
288 ram 1.10 (let ((stream (in-synonym-of stream)))
289     (if (funcall (stream-misc stream) stream :listen)
290     ;; On t or :eof get READ-CHAR to do the work.
291     (read-char stream eof-errorp eof-value)
292     nil)))
293 ram 1.1
294     (defun clear-input (&optional (stream *standard-input*))
295     "Clears any buffered input associated with the Stream."
296     (let ((stream (in-synonym-of stream)))
297     (setf (stream-in-index stream) in-buffer-length)
298 ram 1.2 (funcall (stream-misc stream) stream :clear-input)
299     nil))
300 ram 1.1
301     (defun read-byte (stream &optional (eof-errorp t) eof-value)
302     "Returns the next byte of the Stream."
303     (let* ((stream (in-synonym-of stream))
304     (index (stream-in-index stream)))
305     (declare (fixnum index))
306     (if (eql index in-buffer-length)
307     (funcall (stream-bin stream) stream eof-errorp eof-value)
308     (prog1 (aref (stream-in-buffer stream) index)
309     (setf (stream-in-index stream) (1+ index))))))
310    
311     (defun read-n-bytes (stream buffer start numbytes &optional (eof-errorp t))
312     "Reads Numbytes bytes into the Buffer starting at Start, and returns
313     the number of bytes actually read if the end of file was hit before Numbytes
314     bytes were read (and Eof-Errorp is false)."
315     (declare (fixnum numbytes))
316     (let* ((stream (in-synonym-of stream))
317     (in-buffer (stream-in-buffer stream))
318     (index (stream-in-index stream))
319     (num-buffered (- in-buffer-length index)))
320     (declare (fixnum index num-buffered))
321     (cond
322 ram 1.2 ((not in-buffer)
323 ram 1.1 (with-in-stream stream stream-n-bin buffer start numbytes eof-errorp))
324 wlott 1.4 ((not (typep in-buffer
325     '(or simple-string (simple-array (unsigned-byte 8) (*)))))
326 ram 1.1 (error "N-Bin only works on 8-bit-like streams."))
327     ((<= numbytes num-buffered)
328     (%primitive byte-blt in-buffer index buffer start (+ start numbytes))
329     (setf (stream-in-index stream) (+ index numbytes))
330     numbytes)
331     (t
332     (let ((end (+ start num-buffered)))
333     (%primitive byte-blt in-buffer index buffer start end)
334     (setf (stream-in-index stream) in-buffer-length)
335     (+ (with-in-stream stream stream-n-bin buffer end
336     (- numbytes num-buffered)
337     eof-errorp)
338     num-buffered))))))
339    
340     ;;; Output functions:
341    
342     (defun write-char (character &optional (stream *standard-output*))
343     "Outputs the Character to the Stream."
344     (with-out-stream stream stream-out character)
345     character)
346    
347     (defun terpri (&optional (stream *standard-output*))
348     "Outputs a new line to the Stream."
349     (with-out-stream stream stream-out #\newline)
350     nil)
351    
352     (defun fresh-line (&optional (stream *standard-output*))
353     "Outputs a new line to the Stream if it is not positioned at the begining of
354     a line. Returns T if it output a new line, nil otherwise."
355     (let ((stream (out-synonym-of stream)))
356     (when (/= (or (charpos stream) 1) 0)
357     (funcall (stream-out stream) stream #\newline)
358     t)))
359    
360     (defun write-string (string &optional (stream *standard-output*)
361     &key (start 0) (end (length (the vector string))))
362     "Outputs the String to the given Stream."
363     (write-string* string stream start end))
364    
365     (defun write-string* (string &optional (stream *standard-output*)
366     (start 0) (end (length (the vector string))))
367     (declare (fixnum start end))
368     (if (array-header-p string)
369     (with-array-data ((data string) (offset-start start) (offset-end end))
370     (with-out-stream stream stream-sout data offset-start offset-end))
371     (with-out-stream stream stream-sout string start end))
372     string)
373    
374     (defun write-line (string &optional (stream *standard-output*)
375     &key (start 0) (end (length string)))
376     "Outputs the String to the given Stream, followed by a newline character."
377     (write-line* string stream start end))
378    
379     (defun write-line* (string &optional (stream *standard-output*)
380     (start 0) (end (length string)))
381     (declare (fixnum start end))
382     (let ((stream (out-synonym-of stream)))
383     (if (array-header-p string)
384     (with-array-data ((data string) (offset-start start) (offset-end end))
385     (with-out-stream stream stream-sout data offset-start offset-end))
386     (with-out-stream stream stream-sout string start end))
387     (funcall (stream-out stream) stream #\newline))
388     string)
389    
390     (defun charpos (&optional (stream *standard-output*))
391     "Returns the number of characters on the current line of output of the given
392     Stream, or Nil if that information is not availible."
393     (with-out-stream stream stream-misc :charpos))
394    
395     (defun line-length (&optional (stream *standard-output*))
396     "Returns the number of characters that will fit on a line of output on the
397     given Stream, or Nil if that information is not available."
398     (with-out-stream stream stream-misc :line-length))
399    
400     (defun finish-output (&optional (stream *standard-output*))
401     "Attempts to ensure that all output sent to the the Stream has reached its
402     destination, and only then returns."
403     (with-out-stream stream stream-misc :finish-output)
404     nil)
405    
406     (defun force-output (&optional (stream *standard-output*))
407     "Attempts to force any buffered output to be sent."
408     (with-out-stream stream stream-misc :force-output)
409     nil)
410    
411     (defun clear-output (&optional (stream *standard-output*))
412     "Clears the given output Stream."
413     (with-out-stream stream stream-misc :clear-output)
414     nil)
415    
416     (defun write-byte (integer stream)
417     "Outputs the Integer to the binary Stream."
418     (with-out-stream stream stream-bout integer)
419     integer)
420    
421     ;;;; Broadcast streams:
422    
423     (defstruct (broadcast-stream (:include stream
424     (out #'broadcast-out)
425     (bout #'broadcast-bout)
426     (sout #'broadcast-sout)
427     (misc #'broadcast-misc))
428     (:print-function %print-broadcast-stream)
429     (:constructor make-broadcast-stream (&rest streams)))
430     ;; This is a list of all the streams we broadcast to.
431     streams)
432    
433     (setf (documentation 'make-broadcast-stream 'function)
434     "Returns an ouput stream which sends its output to all of the given streams.")
435    
436     (defun %print-broadcast-stream (s stream d)
437     (declare (ignore s d))
438     (write-string "#<Broadcast Stream>" stream))
439    
440     (macrolet ((out-fun (fun method &rest args)
441     `(defun ,fun (stream ,@args)
442     (dolist (stream (broadcast-stream-streams stream))
443     (funcall (,method stream) stream ,@args)))))
444     (out-fun broadcast-out stream-out char)
445     (out-fun broadcast-bout stream-bout byte)
446     (out-fun broadcast-sout stream-sout string start end))
447    
448     (defun broadcast-misc (stream operation &optional arg1 arg2)
449     (let ((streams (broadcast-stream-streams stream)))
450     (case operation
451     (:charpos
452     (dolist (stream streams)
453     (let ((charpos (funcall (stream-misc stream) stream :charpos)))
454     (if charpos (return charpos)))))
455     (:line-length
456     (let ((min nil))
457     (dolist (stream streams min)
458     (let ((res (funcall (stream-misc stream) stream :line-length)))
459     (when res (setq min (if min (min res min) res)))))))
460     (:element-type
461     (let (res)
462     (dolist (stream streams (if (> (length res) 1) `(and ,@res) res))
463     (pushnew (funcall (stream-misc stream) stream :element-type) res
464     :test #'equal))))
465     (t
466     (let ((res nil))
467     (dolist (stream streams res)
468     (setq res (funcall (stream-misc stream) stream operation
469     arg1 arg2))))))))
470    
471     ;;;; Synonym Streams:
472    
473     (defstruct (synonym-stream (:include stream
474     (in #'synonym-in)
475     (bin #'synonym-bin)
476     (n-bin #'synonym-n-bin)
477     (out #'synonym-out)
478     (bout #'synonym-bout)
479     (sout #'synonym-sout)
480     (misc #'synonym-misc))
481     (:print-function %print-synonym-stream)
482     (:constructor make-synonym-stream (symbol)))
483     ;; This is the symbol, the value of which is the stream we are synonym to.
484     symbol)
485    
486     (defun %print-synonym-stream (s stream d)
487     (declare (ignore d))
488     (format stream "#<Synonym Stream to ~S>" (synonym-stream-symbol s)))
489    
490     (setf (documentation 'make-synonym-stream 'function)
491     "Returns a stream which performs its operations on the stream which is the
492     value of the dynamic variable named by Symbol.")
493    
494     ;;; The output simple output methods just call the corresponding method
495     ;;; in the synonymed stream.
496     ;;;
497     (macrolet ((out-fun (name slot &rest args)
498     `(defun ,name (stream ,@args)
499 ram 1.11 (declare (optimize (safety 1)))
500 ram 1.1 (let ((syn (symbol-value (synonym-stream-symbol stream))))
501     (funcall (,slot syn) syn ,@args)))))
502     (out-fun synonym-out stream-out ch)
503     (out-fun synonym-bout stream-bout n)
504     (out-fun synonym-sout stream-sout string start end))
505    
506    
507     ;;; Bind synonym stream to this so that SPIO can turn on the right frob in
508     ;;; the icon when we are in a terminal input wait.
509     ;;;
510     (defvar *previous-stream* nil)
511    
512     ;;; For the input methods, we just call the corresponding function on the
513     ;;; synonymed stream. These functions deal with getting input out of
514     ;;; the In-Buffer if there is any.
515     ;;;
516     (macrolet ((in-fun (name fun &rest args)
517     `(defun ,name (stream ,@args)
518 ram 1.11 (declare (optimize (safety 1)))
519 ram 1.1 (let ((*previous-stream* stream))
520     (,fun (symbol-value (synonym-stream-symbol stream)) ,@args)))))
521     (in-fun synonym-in read-char eof-errorp eof-value)
522     (in-fun synonym-bin read-byte eof-errorp eof-value)
523     (in-fun synonym-n-bin read-n-bytes buffer start numbytes eof-errorp))
524    
525    
526     ;;; Synonym-Misc -- Internal
527     ;;;
528     ;;; We have to special-case the operations which could look at stuff in
529     ;;; the in-buffer.
530     ;;;
531     (defun synonym-misc (stream operation &optional arg1 arg2)
532 ram 1.11 (declare (optimize (safety 1)))
533 ram 1.1 (let ((syn (symbol-value (synonym-stream-symbol stream)))
534     (*previous-stream* stream))
535     (case operation
536     (:read-line (read-line syn))
537     (:listen (or (/= (the fixnum (stream-in-index syn)) in-buffer-length)
538     (funcall (stream-misc syn) syn :listen)))
539     (t
540     (funcall (stream-misc syn) syn operation arg1 arg2)))))
541    
542     ;;;; Two-Way streams:
543    
544     (defstruct (two-way-stream
545     (:include stream
546     (in #'two-way-in)
547     (bin #'two-way-bin)
548     (n-bin #'two-way-n-bin)
549     (out #'two-way-out)
550     (bout #'two-way-bout)
551     (sout #'two-way-sout)
552     (misc #'two-way-misc))
553     (:print-function %print-two-way-stream)
554     (:constructor make-two-way-stream (input-stream output-stream)))
555     ;; We read from this stream...
556     input-stream
557     ;; And write to this one
558     output-stream)
559    
560     (defun %print-two-way-stream (s stream d)
561     (declare (ignore d))
562     (format stream "#<Two-Way Stream, Input = ~S, Output = ~S>"
563     (two-way-stream-input-stream s)
564     (two-way-stream-output-stream s)))
565    
566     (setf (documentation 'make-two-way-stream 'function)
567     "Returns a bidirectional stream which gets its input from Input-Stream and
568     sends its output to Output-Stream.")
569    
570     (macrolet ((out-fun (name slot &rest args)
571     `(defun ,name (stream ,@args)
572     (let ((syn (two-way-stream-output-stream stream)))
573     (funcall (,slot syn) syn ,@args)))))
574     (out-fun two-way-out stream-out ch)
575     (out-fun two-way-bout stream-bout n)
576     (out-fun two-way-sout stream-sout string start end))
577    
578     (macrolet ((in-fun (name fun &rest args)
579     `(defun ,name (stream ,@args)
580 ram 1.10 (force-output (two-way-stream-output-stream stream))
581 ram 1.1 (,fun (two-way-stream-input-stream stream) ,@args))))
582     (in-fun two-way-in read-char eof-errorp eof-value)
583     (in-fun two-way-bin read-byte eof-errorp eof-value)
584     (in-fun two-way-n-bin read-n-bytes buffer start numbytes eof-errorp))
585    
586     (defun two-way-misc (stream operation &optional arg1 arg2)
587     (let* ((in (two-way-stream-input-stream stream))
588     (in-method (stream-misc in))
589     (out (two-way-stream-output-stream stream))
590     (out-method (stream-misc out)))
591     (case operation
592     (:listen (or (/= (the fixnum (stream-in-index in)) in-buffer-length)
593     (funcall in-method in :listen)))
594 ram 1.10 (:read-line
595     (force-output out)
596     (read-line in arg1 arg2))
597 ram 1.1 ((:finish-output :force-output :clear-output)
598     (funcall out-method out operation arg1 arg2))
599     ((:clear-input :unread)
600     (funcall in-method in operation arg1 arg2))
601     (:element-type
602     (let ((in-type (funcall in-method in :element-type))
603     (out-type (funcall out-method out :element-type)))
604     (if (equal in-type out-type)
605     in-type `(and ,in-type ,out-type))))
606     (:close
607     (funcall in-method in :close arg1)
608     (funcall out-method out :close arg1)
609     (set-closed-flame stream))
610     (t
611     (or (funcall in-method in operation arg1 arg2)
612     (funcall out-method out operation arg1 arg2))))))
613    
614     ;;;; Concatenated Streams:
615    
616     (defstruct (concatenated-stream
617     (:include stream
618     (in #'concatenated-in)
619     (bin #'concatenated-bin)
620     (misc #'concatenated-misc))
621     (:print-function %print-concatenated-stream)
622     (:constructor
623     make-concatenated-stream (&rest streams &aux (current streams))))
624     ;; The car of this is the stream we are reading from now.
625     current
626     ;; This is a list of all the streams. We need to remember them so that
627     ;; we can close them.
628     streams)
629    
630     (defun %print-concatenated-stream (s stream d)
631     (declare (ignore d))
632     (format stream "#<Concatenated Stream, Streams = ~S>"
633     (concatenated-stream-streams s)))
634    
635     (setf (documentation 'make-concatenated-stream 'function)
636     "Returns a stream which takes its input from each of the Streams in turn,
637     going on to the next at EOF.")
638    
639     (macrolet ((in-fun (name fun)
640     `(defun ,name (stream eof-errorp eof-value)
641     (do ((current (concatenated-stream-current stream) (cdr current)))
642     ((null current)
643     (eof-or-lose stream eof-errorp eof-value))
644     (let* ((stream (car current))
645     (result (,fun stream nil nil)))
646     (when result (return result)))
647     (setf (concatenated-stream-current stream) current)))))
648     (in-fun concatenated-in read-char)
649     (in-fun concatenated-bin read-byte))
650    
651     ;;; Concatenated-Readline is somewhat hairy, since we may need to
652     ;;; do several readlines and concatenate the result if the lines are
653     ;;; terminated by eof.
654     ;;;
655     (defun concatenated-readline (stream eof-errorp eof-value)
656     ;; Loop until we find a stream that will give us something or we error
657     ;; out.
658     (do ((current (concatenated-stream-current stream) (cdr current)))
659     ((null current)
660     (eof-or-lose stream eof-errorp eof-value))
661     (setf (concatenated-stream-current stream) current)
662     (let ((this (car current)))
663     (multiple-value-bind (result eofp)
664 ram 1.7 (read-line this nil :eof)
665     (declare (type (or simple-string (member :eof)) result))
666 ram 1.1 ;; Once we have found some input, we loop until we either find a
667     ;; line not terminated by eof or hit eof on the last stream.
668 ram 1.7 (unless (eq result :eof)
669 ram 1.1 (do ((current (cdr current) (cdr current))
670     (new ""))
671     ((or (not eofp) (null current))
672     (return-from concatenated-readline (values result eofp)))
673 ram 1.6 (declare (type (or simple-string (member :eof)) new))
674 ram 1.1 (setf (concatenated-stream-current stream) current)
675     (let ((this (car current)))
676     (multiple-value-setq (new eofp)
677 ram 1.6 (read-line this nil :eof))
678 ram 1.7 (if (eq new :eof)
679     (setq eofp t)
680     (setq result (concatenate 'simple-string result new))))))))))
681 ram 1.1
682     (defun concatenated-misc (stream operation &optional arg1 arg2)
683     (if (eq operation :read-line)
684     (concatenated-readline stream arg1 arg2)
685     (let ((left (concatenated-stream-current stream)))
686     (when left
687     (let* ((current (car left))
688     (misc (stream-misc current)))
689     (case operation
690 ram 1.10 (:listen
691     (loop
692     (let ((stuff (funcall misc current :listen)))
693     (cond ((eq stuff :eof)
694     ;; Advance current, and try again.
695     (pop (concatenated-stream-current stream))
696     (setf current
697     (car (concatenated-stream-current stream)))
698     (unless current
699     ;; No further streams. EOF.
700     (return :eof))
701     (setf misc (stream-misc current)))
702     (stuff
703     ;; Stuff's available.
704     (return t))
705     (t
706     ;; Nothing available yet.
707     (return nil))))))
708 ram 1.1 (:close
709     (dolist (stream (concatenated-stream-streams stream))
710     (funcall (stream-misc stream) stream :close arg1))
711     (set-closed-flame stream))
712     (t
713     (funcall misc current operation arg1 arg2))))))))
714    
715     ;;;; Echo Streams:
716    
717     (defstruct (echo-stream
718     (:include two-way-stream
719     (in #'echo-in)
720     (bin #'echo-bin)
721     (misc #'echo-misc)
722     (n-bin #'ill-bin))
723     (:print-function %print-echo-stream)
724 wlott 1.8 (:constructor make-echo-stream (input-stream output-stream)))
725     unread-stuff)
726 ram 1.1
727    
728     (macrolet ((in-fun (name fun out-slot &rest args)
729     `(defun ,name (stream ,@args)
730 wlott 1.8 (or (pop (echo-stream-unread-stuff stream))
731     (let* ((in (echo-stream-input-stream stream))
732     (out (echo-stream-output-stream stream))
733     (result (,fun in ,@args)))
734     (funcall (,out-slot out) out result)
735     result)))))
736 ram 1.1 (in-fun echo-in read-char stream-out eof-errorp eof-value)
737     (in-fun echo-bin read-byte stream-bout eof-errorp eof-value))
738    
739     (defun echo-misc (stream operation &optional arg1 arg2)
740     (let* ((in (two-way-stream-input-stream stream))
741     (in-method (stream-misc in))
742     (out (two-way-stream-output-stream stream))
743     (out-method (stream-misc out)))
744     (case operation
745 wlott 1.8 (:listen (or (not (null (echo-stream-unread-stuff stream)))
746     (/= (the fixnum (stream-in-index in)) in-buffer-length)
747 ram 1.1 (funcall in-method in :listen)))
748 wlott 1.8 (:unread (push arg1 (echo-stream-unread-stuff stream)))
749 ram 1.1 (:read-line
750 wlott 1.8 (let* ((stuff (echo-stream-unread-stuff stream))
751     (newline-pos (position #\newline stuff)))
752     (if newline-pos
753     (progn
754     (setf (echo-stream-unread-stuff stream)
755     (subseq stuff (1+ newline-pos)))
756     (values (coerce (subseq stuff 0 newline-pos) 'simple-string)
757     nil))
758     (multiple-value-bind (result eofp)
759     (read-line in arg1 arg2)
760     (if eofp
761     (write-string result out)
762     (write-line result out))
763     (setf (echo-stream-unread-stuff stream) nil)
764     (values (if stuff
765     (concatenate 'simple-string stuff result)
766     result)
767     eofp)))))
768 ram 1.1 (:element-type
769     (let ((in-type (funcall in-method in :element-type))
770     (out-type (funcall out-method out :element-type)))
771     (if (equal in-type out-type)
772     in-type `(and ,in-type ,out-type))))
773     (:close
774     (funcall in-method in :close arg1)
775     (funcall out-method out :close arg1)
776     (set-closed-flame stream))
777     (t
778     (or (funcall in-method in operation arg1 arg2)
779     (funcall out-method out operation arg1 arg2))))))
780    
781     (defun %print-echo-stream (s stream d)
782     (declare (ignore d))
783     (format stream "#<Echo Stream, Input = ~S, Output = ~S>"
784     (two-way-stream-input-stream s)
785     (two-way-stream-output-stream s)))
786    
787     (setf (documentation 'make-echo-stream 'function)
788     "Returns a bidirectional stream which gets its input from Input-Stream and
789     sends its output to Output-Stream. In addition, all input is echoed to
790     the output stream")
791    
792     ;;;; String Input Streams:
793    
794     (defstruct (string-input-stream
795     (:include stream
796     (in #'string-inch)
797     (misc #'string-in-misc))
798     (:print-function %print-string-input-stream)
799 ram 1.10 ;(:constructor nil)
800 ram 1.1 (:constructor internal-make-string-input-stream
801     (string current end)))
802     (string nil :type simple-string)
803     (current nil :type fixnum)
804     (end nil :type fixnum))
805    
806     (defun %print-string-input-stream (s stream d)
807     (declare (ignore s d))
808     (write-string "#<String-Input Stream>" stream))
809    
810     (defun string-inch (stream eof-errorp eof-value)
811     (let ((string (string-input-stream-string stream))
812     (index (string-input-stream-current stream)))
813     (declare (simple-string string) (fixnum index))
814     (cond ((= index (the fixnum (string-input-stream-end stream)))
815     (eof-or-lose stream eof-errorp eof-value))
816     (t
817     (setf (string-input-stream-current stream) (1+ index))
818     (aref string index)))))
819    
820     (defun string-in-misc (stream operation &optional arg1 arg2)
821     (case operation
822 ram 1.2 (:file-position
823 ram 1.5 (if arg1
824     (setf (string-input-stream-current stream) arg1)
825     (string-input-stream-current stream)))
826     (:file-length (length (string-input-stream-string stream)))
827 ram 1.1 (:read-line
828     (let ((string (string-input-stream-string stream))
829     (current (string-input-stream-current stream))
830     (end (string-input-stream-end stream)))
831     (declare (simple-string string) (fixnum current end))
832     (if (= current end)
833     (eof-or-lose stream arg1 arg2)
834 wlott 1.4 (let ((pos (position #\newline string :start current :end end)))
835 ram 1.1 (if pos
836     (let* ((res-length (- (the fixnum pos) current))
837     (result (make-string res-length)))
838     (%primitive byte-blt string current result 0 res-length)
839     (setf (string-input-stream-current stream)
840     (1+ (the fixnum pos)))
841     (values result nil))
842     (let* ((res-length (- end current))
843     (result (make-string res-length)))
844     (%primitive byte-blt string current result 0 res-length)
845     (setf (string-input-stream-current stream) end)
846     (values result t)))))))
847     (:unread (decf (string-input-stream-current stream)))
848 ram 1.10 (:listen (or (/= (the fixnum (string-input-stream-current stream))
849     (the fixnum (string-input-stream-end stream)))
850     :eof))
851 ram 1.1 (:element-type 'string-char)))
852    
853     (defun make-string-input-stream (string &optional
854     (start 0) (end (length string)))
855     "Returns an input stream which will supply the characters of String between
856     Start and End in order."
857     (if (stringp string)
858     (internal-make-string-input-stream (coerce string 'simple-string)
859     start end)
860     (error "~S is not a string." string)))
861    
862     ;;;; String Output Streams:
863    
864     (defstruct (string-output-stream
865     (:include stream
866     (out #'string-ouch)
867     (sout #'string-sout)
868     (misc #'string-out-misc))
869     (:print-function %print-string-output-stream)
870     (:constructor make-string-output-stream ()))
871     ;; The string we throw stuff in.
872     (string (make-string 40) :type simple-string)
873     ;; Index of the next location to use.
874     (index 0 :type fixnum))
875    
876     (defun %print-string-output-stream (s stream d)
877     (declare (ignore s d))
878     (write-string "#<String-Output Stream>" stream))
879    
880     (setf (documentation 'make-string-output-stream 'function)
881     "Returns an Output stream which will accumulate all output given it for
882     the benefit of the function Get-Output-Stream-String.")
883    
884     (defun string-ouch (stream character)
885     (let ((current (string-output-stream-index stream))
886     (workspace (string-output-stream-string stream)))
887     (declare (simple-string workspace) (fixnum current))
888     (if (= current (the fixnum (length workspace)))
889     (let ((new-workspace (make-string (* current 2))))
890     (%primitive byte-blt workspace 0 new-workspace 0 current)
891     (setf (aref new-workspace current) character)
892     (setf (string-output-stream-string stream) new-workspace))
893     (setf (aref workspace current) character))
894     (setf (string-output-stream-index stream) (1+ current))))
895    
896     (defun string-sout (stream string start end)
897     (declare (simple-string string) (fixnum start end))
898     (let* ((current (string-output-stream-index stream))
899     (length (- end start))
900     (dst-end (+ length current))
901     (workspace (string-output-stream-string stream)))
902     (declare (simple-string workspace)
903     (fixnum current length dst-end))
904     (if (> dst-end (the fixnum (length workspace)))
905     (let ((new-workspace (make-string (+ (* current 2) length))))
906     (%primitive byte-blt workspace 0 new-workspace 0 current)
907     (%primitive byte-blt string start new-workspace current dst-end)
908     (setf (string-output-stream-string stream) new-workspace))
909     (%primitive byte-blt string start workspace current dst-end))
910     (setf (string-output-stream-index stream) dst-end)))
911    
912     (defun string-out-misc (stream operation &optional arg1 arg2)
913 ram 1.3 (declare (ignore arg2))
914 ram 1.1 (case operation
915 ram 1.2 (:file-position
916     (if (null arg1)
917 ram 1.3 (string-output-stream-index stream)))
918 ram 1.1 (:charpos
919     (do ((index (1- (the fixnum (string-output-stream-index stream)))
920     (1- index))
921     (count 0 (1+ count))
922     (string (string-output-stream-string stream)))
923     ((< index 0) count)
924     (declare (simple-string string)
925     (fixnum index count))
926     (if (char= (schar string index) #\newline)
927     (return count))))
928     (:element-type 'string-char)))
929    
930     (defun get-output-stream-string (stream)
931     "Returns a string of all the characters sent to a stream made by
932     Make-String-Output-Stream since the last call to this function."
933     (if (streamp stream)
934     (let* ((length (string-output-stream-index stream))
935     (result (make-string length)))
936     (%primitive byte-blt (string-output-stream-string stream) 0
937     result 0 length)
938     (setf (string-output-stream-index stream) 0)
939     result)
940     (error "~S is not a string stream.")))
941    
942     (defun dump-output-stream-string (in-stream out-stream)
943     "Dumps the characters buffer up in the In-Stream to the Out-Stream as
944     Get-Output-Stream-String would return them."
945     (write-string (string-output-stream-string in-stream) out-stream
946     :start 0 :end (string-output-stream-index in-stream))
947     (setf (string-output-stream-index in-stream) 0))
948    
949     ;;;; Fill-pointer streams:
950     ;;;
951     ;;; Fill pointer string output streams are not explicitly mentioned in
952     ;;; the CLM, but they are required for the implementation of With-Output-To-String.
953    
954     (defstruct (fill-pointer-output-stream
955     (:include stream
956     (out #'fill-pointer-ouch)
957     (sout #'fill-pointer-sout)
958     (misc #'fill-pointer-misc))
959     (:print-function
960     (lambda (s stream d)
961     (declare (ignore s d))
962     (write-string "#<Fill-Pointer String Output Stream>" stream)))
963     (:constructor make-fill-pointer-output-stream (string)))
964     ;; The string we throw stuff in.
965     string)
966    
967    
968     (defun fill-pointer-ouch (stream character)
969     (let* ((buffer (fill-pointer-output-stream-string stream))
970 wlott 1.4 (current (fill-pointer buffer))
971 ram 1.1 (current+1 (1+ current)))
972     (declare (fixnum current))
973     (with-array-data ((workspace buffer) (start) (end))
974     (declare (simple-string workspace))
975     (let ((offset-current (+ start current)))
976     (declare (fixnum offset-current))
977     (if (= offset-current end)
978     (let* ((new-length (* current 2))
979     (new-workspace (make-string new-length)))
980     (declare (simple-string new-workspace))
981     (%primitive byte-blt workspace start new-workspace 0 current)
982     (setf workspace new-workspace)
983     (setf offset-current current)
984     (set-array-header buffer workspace new-length
985     current+1 0 new-length nil))
986 wlott 1.4 (setf (fill-pointer buffer) current+1))
987 ram 1.1 (setf (schar workspace offset-current) character)))
988     current+1))
989    
990    
991     (defun fill-pointer-sout (stream string start end)
992     (declare (simple-string string) (fixnum start end))
993     (let* ((buffer (fill-pointer-output-stream-string stream))
994 wlott 1.4 (current (fill-pointer buffer))
995 ram 1.1 (string-len (- end start))
996     (dst-end (+ string-len current)))
997     (declare (fixnum current dst-end string-len))
998     (with-array-data ((workspace buffer) (dst-start) (dst-length))
999     (declare (simple-string workspace))
1000     (let ((offset-dst-end (+ dst-start dst-end))
1001     (offset-current (+ dst-start current)))
1002     (declare (fixnum offset-dst-end offset-current))
1003     (if (> offset-dst-end dst-length)
1004     (let* ((new-length (+ (the fixnum (* current 2)) string-len))
1005     (new-workspace (make-string new-length)))
1006     (declare (simple-string new-workspace))
1007     (%primitive byte-blt workspace dst-start new-workspace 0 current)
1008     (setf workspace new-workspace)
1009     (setf offset-current current)
1010     (setf offset-dst-end dst-end)
1011     (set-array-header buffer workspace new-length
1012     dst-end 0 new-length nil))
1013 wlott 1.4 (setf (fill-pointer buffer) dst-end))
1014 ram 1.1 (%primitive byte-blt string start
1015     workspace offset-current offset-dst-end)))
1016     dst-end))
1017    
1018    
1019     (defun fill-pointer-misc (stream operation &optional arg1 arg2)
1020     (declare (ignore arg1 arg2))
1021     (case operation
1022     (:charpos
1023     (let* ((buffer (fill-pointer-output-stream-string stream))
1024 wlott 1.4 (current (fill-pointer buffer)))
1025 ram 1.1 (with-array-data ((string buffer) (start) (end current))
1026     (declare (simple-string string) (ignore start))
1027     (let ((found (position #\newline string :test #'char=
1028     :end end :from-end t)))
1029     (if found
1030     (- end (the fixnum found))
1031     current)))))
1032     (:element-type 'string-char)))
1033    
1034     ;;;; Indenting streams:
1035    
1036     (defstruct (indenting-stream (:include stream
1037     (out #'indenting-out)
1038     (sout #'indenting-sout)
1039     (misc #'indenting-misc))
1040     (:print-function %print-indenting-stream)
1041     (:constructor make-indenting-stream (stream)))
1042     ;; The stream we're based on:
1043     stream
1044     ;; How much we indent on each line:
1045     (indentation 0))
1046    
1047     (setf (documentation 'make-indenting-stream 'function)
1048     "Returns an ouput stream which indents its output by some amount.")
1049    
1050     (defun %print-indenting-stream (s stream d)
1051     (declare (ignore s d))
1052     (write-string "#<Indenting Stream>" stream))
1053    
1054     ;;; Indenting-Indent writes the right number of spaces needed to indent output on
1055     ;;; the given Stream based on the specified Sub-Stream.
1056    
1057     (defmacro indenting-indent (stream sub-stream)
1058     `(do ((i 0 (+ i 60))
1059     (indentation (indenting-stream-indentation ,stream)))
1060     ((>= i indentation))
1061     (funcall (stream-sout ,sub-stream) ,sub-stream
1062     " "
1063     0 (min 60 (- indentation i)))))
1064    
1065     ;;; Indenting-Out writes a character to an indenting stream.
1066    
1067     (defun indenting-out (stream char)
1068     (let ((sub-stream (indenting-stream-stream stream)))
1069     (funcall (stream-out sub-stream) sub-stream char)
1070     (if (char= char #\newline)
1071     (indenting-indent stream sub-stream))))
1072    
1073     ;;; Indenting-Sout writes a string to an indenting stream.
1074    
1075     (defun indenting-sout (stream string start end)
1076     (declare (simple-string string) (fixnum start end))
1077     (do ((i start)
1078     (sub-stream (indenting-stream-stream stream)))
1079     ((= i end))
1080     (let ((newline (position #\newline string :start i :end end)))
1081     (cond (newline
1082     (funcall (stream-sout sub-stream) sub-stream string i (1+ newline))
1083     (indenting-indent stream sub-stream)
1084     (setq i (+ newline 1)))
1085     (t
1086     (funcall (stream-sout sub-stream) sub-stream string i end)
1087     (setq i end))))))
1088    
1089     ;;; Indenting-Misc just treats just the :Line-Length message differently.
1090     ;;; Indenting-Charpos says the charpos is the charpos of the base stream minus
1091     ;;; the stream's indentation.
1092    
1093     (defun indenting-misc (stream operation &optional arg1 arg2)
1094     (let* ((sub-stream (indenting-stream-stream stream))
1095     (method (stream-misc sub-stream)))
1096     (case operation
1097     (:line-length
1098     (let ((line-length (funcall method sub-stream operation)))
1099     (if line-length
1100     (- line-length (indenting-stream-indentation stream)))))
1101     (:charpos
1102     (let* ((sub-stream (indenting-stream-stream stream))
1103     (charpos (funcall method sub-stream operation)))
1104     (if charpos
1105     (- charpos (indenting-stream-indentation stream)))))
1106     (t
1107     (funcall method sub-stream operation arg1 arg2)))))
1108    
1109     (proclaim '(notinline read-char unread-char read-byte listen))
1110 chiles 1.12
1111    
1112    
1113     ;;;; Public interface from "EXTENSIONS" package.
1114    
1115     (in-package "EXT")
1116    
1117     (export '(get-stream-command stream-command stream-command-p stream-command-name
1118     stream-command-args make-stream-command))
1119    
1120     (defstruct (stream-command (:print-function print-stream-command)
1121     (:constructor make-stream-command
1122     (name &optional args)))
1123     (name nil :type symbol)
1124     (args nil :type list))
1125    
1126     (defun print-stream-command (obj str n)
1127     (declare (ignore n))
1128     (format str "#<Stream-Cmd ~S>" (stream-command-name obj)))
1129    
1130    
1131     ;;; GET-STREAM-COMMAND -- Public.
1132     ;;;
1133     ;;; We can't simply call the stream's misc method because because nil is an
1134     ;;; ambiguous return value: does it mean text arrived, or does it mean the
1135     ;;; stream's misc method had no :get-command implementation. We can't return
1136     ;;; nil until there is text input. We don't need to loop because any stream
1137     ;;; implementing :get-command would wait until it had some input. If the
1138     ;;; LISTEN fails, then we have some random stream we must wait on.
1139     ;;;
1140     (defun get-stream-command (stream)
1141     "This takes a stream and waits for text or a command to appear on it. If
1142     text appears before a command, this returns nil, and otherwise it returns
1143     a command."
1144     (let ((cmdp (funcall (lisp::stream-misc stream) stream :get-command)))
1145     (cond (cmdp)
1146     ((listen stream)
1147     nil)
1148     (t
1149     ;; This waits for input and returns nil when it arrives.
1150     (unread-char (read-char stream) stream)))))

  ViewVC Help
Powered by ViewVC 1.1.5