;;; -*- Mode:LISP; Package:SYSTEM-INTERNALS; Base:8 -*-
;;; ** (C) Copyright 1981, Symbolics, Inc.
;;;    Enhancements (C) Copyright 1981, Massachusetts Institute of Technology
;;; The Massachusetts Institute of Technology has acquired the rights from Symbolics
;;; to include the Software covered by the foregoing notice of copyright with its
;;; licenses of the Lisp Machine System **

;;; Flavor basis for streams

;;; To make a buffered stream:
;;; For input, define :NEXT-INPUT-BUFFER &OPTIONAL NO-HANG-P => ARRAY START END
;;;		      :DISCARD-INPUT-BUFFER ARRAY
;;; For output, define :NEW-OUTPUT-BUFFER => ARRAY START END
;;;		       :SEND-OUTPUT-BUFFER ARRAY END
;;;		       :DISCARD-OUTPUT-BUFFER ARRAY

;;; To make :SET-POINTER work, define :SET-BUFFER-POINTER NEW-POINTER => REAL-NEW-POINTER
;;; where REAL-NEW-POINTER should be such that the next :NEXT-INPUT-BUFFER will access the
;;; desired position somewhere in the buffer.

;;; To make binary streams, mix with
;;; for input	SI:BUFFERED-INPUT-STREAM
;;; for output	SI:BUFFERED-OUTPUT-STREAM
;;; for both	SI:BUFFERED-STREAM

;;; To make character streams, mix with
;;; for input	SI:BUFFERED-INPUT-CHARACTER-STREAM
;;; for output 	SI:BUFFERED-OUTPUT-CHARACTER-STREAM
;;; for both	SI:BUFFERED-CHARACTER-STREAM

;;; To make a character stream that does character set translation or compression or something
;;; like that, define a wrapper on :TYI (:TYO) that does the translation.  Then mix with
;;; for input	SI:BUFFERED-TYI-INPUT-STREAM
;;; for output	SI:BUFFERED-TYO-OUTPUT-STREAM
;;; for both	SI:BUFFERED-TYI-TYO-STREAM

;;; There are mixins in this file (SI:ASCII-TRANSLATING-INPUT-STREAM-MIXIN and
;;;	SI:ASCII-TRANSLATING-OUTPUT-STREAM-MIXIN) for translating between ASCII and Lisp
;;;	machine character set.

;;; For file streams, the mixin SI:STREAM-WITH-PATHNAME-MIXIN handles the pathname and
;;; printing nicely.  Use this for :PROBE openings (since they cannot do I/O).
;;; For input file streams, use SI:INPUT-FILE-STREAM-MIXIN.
;;; For output file streams, use SI:OUTPUT-FILE-STREAM-MIXIN.
;;; These make you interact with the who-line correctly.

;;; Base flavors

(DEFFLAVOR STREAM () ()
  (:DOCUMENTATION :BASE-FLAVOR "All streams are built on this.
    This flavor is mostly for TYPEP, but also provides default methods for messages
    which all streams, input or output, are required to handle."))

(DEFMETHOD (STREAM :CLOSE) (&OPTIONAL MODE)
  MODE	;ignored
  NIL)

;;; Streams are binary until proven otherwise
(DEFMETHOD (STREAM :CHARACTERS) () NIL)

(DEFMETHOD (STREAM :DIRECTION) () NIL)

(DEFFLAVOR CHARACTER-STREAM () ()
  (:INCLUDED-FLAVORS STREAM))

(DEFMETHOD (CHARACTER-STREAM :CHARACTERS) () T)

(DEFFLAVOR INPUT-STREAM () (STREAM)
  (:REQUIRED-METHODS :TYI :UNTYI)
  (:SELECT-METHOD-ORDER :TYI :UNTYI)
  (:DOCUMENTATION :BASE-FLAVOR "All input streams are built on this."))

(DEFMETHOD (INPUT-STREAM :DIRECTION) () ':INPUT)

(DEFMETHOD (INPUT-STREAM :LISTEN) ()
  (LET ((TEM (FUNCALL-SELF ':TYI)))
    (COND (TEM
	   (FUNCALL-SELF ':UNTYI TEM)
	   T)
	  (T NIL))))

(DEFMETHOD (INPUT-STREAM :TYIPEEK) (&OPTIONAL EOF)
  (LET ((TEM (FUNCALL-SELF ':TYI)))
    (COND (TEM
	   (FUNCALL-SELF ':UNTYI TEM)
	   TEM)
	  (EOF (ERROR EOF))
	  (T NIL))))

(DEFMETHOD (INPUT-STREAM :CLEAR-INPUT) ()
  NIL)

(DEFMETHOD (INPUT-STREAM :READ-UNTIL-EOF) ()
  (LOOP WHILE (FUNCALL-SELF ':TYI)))

(DEFMETHOD (INPUT-STREAM :STRING-IN) (EOF STRING &OPTIONAL (START 0) END)
  (OR END (SETQ END (ARRAY-LENGTH STRING)))
  (LOOP WHILE (< START END)
	AS CH = (FUNCALL-SELF ':TYI)
	WHILE CH
	DO (ASET CH STRING (PROG1 START (INCF START)))
	FINALLY (AND (ARRAY-HAS-LEADER-P STRING)
		     (STORE-ARRAY-LEADER START STRING 0))
		(AND (NULL CH) EOF (ERROR EOF))
		(RETURN (VALUES START (NULL CH)))))

(DEFFLAVOR OUTPUT-STREAM () (STREAM)
  (:REQUIRED-METHODS :TYO)
  (:SELECT-METHOD-ORDER :TYO)
  (:DOCUMENTATION :BASE-FLAVOR "All output streams are built on this."))

(DEFMETHOD (OUTPUT-STREAM :DIRECTION) () ':OUTPUT)

(DEFMETHOD (OUTPUT-STREAM :FRESH-LINE) ()
  (FUNCALL-SELF ':TYO #\CR))

(DEFMETHOD (OUTPUT-STREAM :STRING-OUT) (STRING &OPTIONAL (START 0) END)
  (OR END (SETQ END (ARRAY-ACTIVE-LENGTH STRING)))
  (DO ((I START (1+ I))) (( I END))
    (FUNCALL-SELF ':TYO (AREF STRING I))))

(DEFMETHOD (OUTPUT-STREAM :CLEAR-OUTPUT) ()
  NIL)

(DEFMETHOD (OUTPUT-STREAM :FORCE-OUTPUT) ()
  NIL)

(DEFMETHOD (OUTPUT-STREAM :FINISH) ()
  NIL)

(DEFMETHOD (OUTPUT-STREAM :BEFORE :FINISH) ()
  (FUNCALL-SELF ':FORCE-OUTPUT))

(DEFMETHOD (OUTPUT-STREAM :EOF) ()
  (FUNCALL-SELF ':FINISH))

(DEFFLAVOR BIDIRECTIONAL-STREAM () ()
  (:INCLUDED-FLAVORS INPUT-STREAM OUTPUT-STREAM))

(DEFMETHOD (BIDIRECTIONAL-STREAM :DIRECTION) () ':BIDIRECTIONAL)

;;; Buffered streams

(DEFFLAVOR BASIC-BUFFERED-INPUT-STREAM
	((STREAM-INPUT-BUFFER NIL)
	 (STREAM-INPUT-INDEX NIL)
	 STREAM-INPUT-LIMIT)
	(INPUT-STREAM)
  :GETTABLE-INSTANCE-VARIABLES
  (:REQUIRED-METHODS :NEXT-INPUT-BUFFER :DISCARD-INPUT-BUFFER)
  (:DOCUMENTATION :COMBINATION "Input stream with a buffer.  Defines only a :TYI method.
Requires methods :NEXT-INPUT-BUFFER, which takes a no hang argument and returns three
values, an array, a starting index, and an ending index, or NIL at EOF or no input available
right away.  And :DISCARD-INPUT-BUFFER takes the array back and throws it away someplace."))

;;; Returns non-NIL if any input was to be found.
(DEFMETHOD (BASIC-BUFFERED-INPUT-STREAM :SETUP-NEXT-INPUT-BUFFER) (&OPTIONAL NO-HANG-P)
  (FUNCALL-SELF ':DISCARD-CURRENT-INPUT-BUFFER)
  (MULTIPLE-VALUE (STREAM-INPUT-BUFFER STREAM-INPUT-INDEX STREAM-INPUT-LIMIT)
    (FUNCALL-SELF ':NEXT-INPUT-BUFFER NO-HANG-P)))

(DEFMETHOD (BASIC-BUFFERED-INPUT-STREAM :DISCARD-CURRENT-INPUT-BUFFER) ()
  (COND (STREAM-INPUT-BUFFER
	 ;; Pretend that the index has reached the end, so that input remembering will work.
	 (SETQ STREAM-INPUT-INDEX STREAM-INPUT-LIMIT)
	 (FUNCALL-SELF ':DISCARD-INPUT-BUFFER
		       (PROG1 STREAM-INPUT-BUFFER (SETQ STREAM-INPUT-BUFFER NIL))))))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (BASIC-BUFFERED-INPUT-STREAM)
(DEFUN BASIC-BUFFERED-INPUT-STREAM-TYI (MESSAGE &OPTIONAL EOF)
  (LOOP UNTIL (AND STREAM-INPUT-BUFFER
		   (< STREAM-INPUT-INDEX STREAM-INPUT-LIMIT))
	;Out of input, get some more
	UNTIL (FUNCALL-SELF ':SETUP-NEXT-INPUT-BUFFER (EQ MESSAGE ':TYI-NO-HANG))
	;Reached end of file
	RETURN (AND EOF (ERROR EOF))
	;Here we have a character available
	FINALLY (RETURN (PROG1 (AREF STREAM-INPUT-BUFFER STREAM-INPUT-INDEX)
			       (OR (EQ MESSAGE ':TYIPEEK) (INCF STREAM-INPUT-INDEX)))))) )

(DEFMETHOD (BASIC-BUFFERED-INPUT-STREAM :TYI) BASIC-BUFFERED-INPUT-STREAM-TYI)
(DEFMETHOD (BASIC-BUFFERED-INPUT-STREAM :TYI-NO-HANG) BASIC-BUFFERED-INPUT-STREAM-TYI)
(DEFMETHOD (BASIC-BUFFERED-INPUT-STREAM :TYIPEEK) BASIC-BUFFERED-INPUT-STREAM-TYI)

(DEFMETHOD (BASIC-BUFFERED-INPUT-STREAM :UNTYI) (CH)
  (LET ((NEW-INDEX (AND STREAM-INPUT-BUFFER
			(1- STREAM-INPUT-INDEX))))
    (COND ((AND NEW-INDEX
		( NEW-INDEX 0)
		(EQ (AREF STREAM-INPUT-BUFFER NEW-INDEX) CH))
	   (SETQ STREAM-INPUT-INDEX NEW-INDEX))
	  (T
	   (FERROR NIL "Attempt to :UNTYI something different than last :TYI'ed.")))))

(DEFMETHOD (BASIC-BUFFERED-INPUT-STREAM :LISTEN) ()
  (OR (AND STREAM-INPUT-BUFFER
	   (< STREAM-INPUT-INDEX STREAM-INPUT-LIMIT))
      (FUNCALL-SELF ':SETUP-NEXT-INPUT-BUFFER T)))

(DEFMETHOD (BASIC-BUFFERED-INPUT-STREAM :CLEAR-INPUT) ()
  (FUNCALL-SELF ':DISCARD-CURRENT-INPUT-BUFFER))

(DEFFLAVOR BUFFERED-INPUT-STREAM () (BASIC-BUFFERED-INPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "Buffered input stream with :READ-INPUT-BUFFER.
Usef for all buffered input streams for which :TYI doesn't have wrappers to do
translation or such."))

(DEFMETHOD (BUFFERED-INPUT-STREAM :GET-INPUT-BUFFER) (&OPTIONAL EOF)
  (LOOP UNTIL (AND STREAM-INPUT-BUFFER
		   (< STREAM-INPUT-INDEX STREAM-INPUT-LIMIT))
	;Out of input, get some more
	UNTIL (FUNCALL-SELF ':SETUP-NEXT-INPUT-BUFFER)
	;Reached end of file
	RETURN (AND EOF (ERROR EOF))
	;Here we have a non-empty available
	FINALLY (RETURN (VALUES STREAM-INPUT-BUFFER
				STREAM-INPUT-INDEX
				(- STREAM-INPUT-LIMIT STREAM-INPUT-INDEX)))))

(DEFMETHOD (BUFFERED-INPUT-STREAM :READ-INPUT-BUFFER) (&OPTIONAL EOF)
  (LOOP UNTIL (AND STREAM-INPUT-BUFFER
		   (< STREAM-INPUT-INDEX STREAM-INPUT-LIMIT))
	;Out of input, get some more
	UNTIL (FUNCALL-SELF ':SETUP-NEXT-INPUT-BUFFER)
	;Reached end of file
	RETURN (AND EOF (ERROR EOF))
	;Here we have a non-empty available
	FINALLY (RETURN (VALUES STREAM-INPUT-BUFFER STREAM-INPUT-INDEX STREAM-INPUT-LIMIT))))

(DEFMETHOD (BUFFERED-INPUT-STREAM :STRING-IN) (EOF STRING &OPTIONAL (START 0) END)
  (OR END (SETQ END (ARRAY-LENGTH STRING)))
  (LOOP WHILE (< START END)
	WHILE (LOOP UNTIL (AND STREAM-INPUT-BUFFER
			       (< STREAM-INPUT-INDEX STREAM-INPUT-LIMIT))
		    ;Out of input, get some more
		    UNTIL (FUNCALL-SELF ':SETUP-NEXT-INPUT-BUFFER)
		    DO (AND EOF (ERROR EOF))
		    RETURN NIL
		    FINALLY (RETURN T))
	AS AMT = (MIN (- END START) (- STREAM-INPUT-LIMIT STREAM-INPUT-INDEX))
	DO (COPY-ARRAY-PORTION STREAM-INPUT-BUFFER STREAM-INPUT-INDEX
			       (SETQ STREAM-INPUT-INDEX (+ STREAM-INPUT-INDEX AMT))
			       STRING START (SETQ START (+ START AMT)))
	FINALLY (AND (ARRAY-HAS-LEADER-P STRING)
		     (STORE-ARRAY-LEADER START STRING 0))
		(RETURN (VALUES START (NULL STREAM-INPUT-BUFFER)))))

(DEFMETHOD (BUFFERED-INPUT-STREAM :READ-UNTIL-EOF) ()
  (LOOP WHILE (FUNCALL-SELF ':SETUP-NEXT-INPUT-BUFFER)))

(DEFMETHOD (BUFFERED-INPUT-STREAM :ADVANCE-INPUT-BUFFER) (&OPTIONAL NEW-INDEX)
  (COND (NEW-INDEX
	 (OR (AND ( NEW-INDEX 0)
		  ( NEW-INDEX STREAM-INPUT-LIMIT))
	     (FERROR NIL "New index out of range"))
	 (SETQ STREAM-INPUT-INDEX NEW-INDEX))
	(T
	 (FUNCALL-SELF ':DISCARD-CURRENT-INPUT-BUFFER))))

(DEFMETHOD (BASIC-BUFFERED-INPUT-STREAM :BEFORE :CLOSE) (&OPTIONAL IGNORE)
  (FUNCALL-SELF ':DISCARD-CURRENT-INPUT-BUFFER))

(DEFFLAVOR BASIC-BUFFERED-OUTPUT-STREAM
	((STREAM-OUTPUT-BUFFER NIL)
	 (STREAM-OUTPUT-INDEX NIL)
	 STREAM-OUTPUT-LIMIT)
	(OUTPUT-STREAM)
  :GETTABLE-INSTANCE-VARIABLES
  (:REQUIRED-METHODS :NEW-OUTPUT-BUFFER :SEND-OUTPUT-BUFFER :DISCARD-OUTPUT-BUFFER)
  (:DOCUMENTATION :COMBINATION "Output stream with a buffer.  Only gives a :TYO method.
Required methods are :NEW-OUTPUT-BUFFER, which returns three values, an array, starting index,
and ending index into which characters can be stuffed.  And :SEND-OUTPUT-BUFFER takes the
array and the ending output index reached, and transmit to the particular device.
:DISCARD-OUTPUT-BUFFER takes the array and should forget about sending the buffered data."))

(DEFMETHOD (BASIC-BUFFERED-OUTPUT-STREAM :SETUP-NEW-OUTPUT-BUFFER) ()
  (FUNCALL-SELF ':SEND-CURRENT-OUTPUT-BUFFER)
  (MULTIPLE-VALUE (STREAM-OUTPUT-BUFFER STREAM-OUTPUT-INDEX STREAM-OUTPUT-LIMIT)
    (FUNCALL-SELF ':NEW-OUTPUT-BUFFER)))

(DEFMETHOD (BASIC-BUFFERED-OUTPUT-STREAM :SEND-CURRENT-OUTPUT-BUFFER) ()
  (COND (STREAM-OUTPUT-BUFFER
	 (FUNCALL-SELF ':SEND-OUTPUT-BUFFER
		       ;; If aborted out of write, prefer losing data to
		       ;; getting links circular.
		       (PROG1 STREAM-OUTPUT-BUFFER (SETQ STREAM-OUTPUT-BUFFER NIL))
		       STREAM-OUTPUT-INDEX))))

(DEFMETHOD (BASIC-BUFFERED-OUTPUT-STREAM :DISCARD-CURRENT-OUTPUT-BUFFER) ()
  (AND STREAM-OUTPUT-BUFFER
       (FUNCALL-SELF ':DISCARD-OUTPUT-BUFFER (PROG1 STREAM-OUTPUT-BUFFER
						    (SETQ STREAM-OUTPUT-BUFFER NIL)))))

(DEFMETHOD (BASIC-BUFFERED-OUTPUT-STREAM :TYO) (CH)
  (LOOP UNTIL (AND STREAM-OUTPUT-BUFFER
		   (< STREAM-OUTPUT-INDEX STREAM-OUTPUT-LIMIT))
	DO (FUNCALL-SELF ':SETUP-NEW-OUTPUT-BUFFER)
	FINALLY (ASET CH STREAM-OUTPUT-BUFFER STREAM-OUTPUT-INDEX)
		(INCF STREAM-OUTPUT-INDEX)))

(DEFMETHOD (BASIC-BUFFERED-OUTPUT-STREAM :FORCE-OUTPUT) ()
  (FUNCALL-SELF ':SEND-CURRENT-OUTPUT-BUFFER))

(DEFMETHOD (BASIC-BUFFERED-OUTPUT-STREAM :BEFORE :CLOSE) (&OPTIONAL ABORTP)
  (FUNCALL-SELF (IF ABORTP ':DISCARD-CURRENT-OUTPUT-BUFFER
			   ':SEND-CURRENT-OUTPUT-BUFFER)))

(DEFFLAVOR BUFFERED-OUTPUT-STREAM () (BASIC-BUFFERED-OUTPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "Buffered output stream with :STRING-OUT.
Should be used for all output streams which do not have wrappers on :TYO to do translation
or such like."))

(DEFMETHOD (BUFFERED-OUTPUT-STREAM :STRING-OUT) (STRING &OPTIONAL (START 0) END)
  (OR END (SETQ END (ARRAY-ACTIVE-LENGTH STRING)))
  (LOOP WHILE (< START END)
	UNLESS STREAM-OUTPUT-BUFFER
	  DO (FUNCALL-SELF ':SETUP-NEW-OUTPUT-BUFFER)
	AS AMT = (MIN (- END START) (- STREAM-OUTPUT-LIMIT STREAM-OUTPUT-INDEX))
	DO (COPY-ARRAY-PORTION STRING START (SETQ START (+ START AMT))
			       STREAM-OUTPUT-BUFFER STREAM-OUTPUT-INDEX
			       (SETQ STREAM-OUTPUT-INDEX (+ STREAM-OUTPUT-INDEX AMT)))
	WHEN (< START END)
	  DO (FUNCALL-SELF ':SEND-CURRENT-OUTPUT-BUFFER)))

;; Since this stream has enough knowledge to execute this message intelligently, let it.
;; Note that this message can't go in BASIC-BUFFERED-OUTPUT-STREAM, because wrappers may
;; be defined on :TYO messages which would cause it to lose.
(DEFMETHOD (BUFFERED-OUTPUT-STREAM :FRESH-LINE) ()
  (OR (AND STREAM-OUTPUT-BUFFER
	   (PLUSP STREAM-OUTPUT-INDEX)
	   (CHAR-EQUAL (AREF STREAM-OUTPUT-BUFFER (1- STREAM-OUTPUT-INDEX)) #\CR))
      (FUNCALL-SELF ':TYO #\CR)))

; LINE input and output

; This comes in two different flavors, depending on whether the stream is buffered
; or unbuffered

(DEFFLAVOR UNBUFFERED-LINE-INPUT-STREAM () (CHARACTER-STREAM INPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "Input stream with :LINE-IN but no buffering.
Used with input streams which only support :TYI."))

(DEFMETHOD (UNBUFFERED-LINE-INPUT-STREAM :LINE-IN) (&OPTIONAL LEADER)
  (LOOP WITH LENGTH-SO-FAR = 0
	 AND LINE = (MAKE-ARRAY 80 ':TYPE 'ART-STRING
				   ':LEADER-LENGTH (AND (NUMBERP LEADER) LEADER))
	 AS CH = (FUNCALL-SELF ':TYI)
	 UNTIL (NULL CH)		;i.e. EOF
	 UNTIL (= CH #\CR)
	 ;We have an ordinary character, stick it on the end of the line
	 WHEN ( LENGTH-SO-FAR (ARRAY-LENGTH LINE))
	   DO (SETQ LINE (ADJUST-ARRAY-SIZE LINE (// (* LENGTH-SO-FAR 3) 2)))
	 DO (ASET CH LINE LENGTH-SO-FAR)
	    (INCF LENGTH-SO-FAR)
	 FINALLY
	  ;Adjust size and active-length of line
	  (ADJUST-ARRAY-SIZE LINE LENGTH-SO-FAR)
	  (IF (ARRAY-HAS-LEADER-P LINE) (STORE-ARRAY-LEADER LENGTH-SO-FAR LINE 0))
	  (RETURN (VALUES LINE (NULL CH)))))

(DEFFLAVOR LINE-OUTPUT-STREAM-MIXIN () ()
  (:REQUIRED-METHODS :STRING-OUT)
  (:INCLUDED-FLAVORS CHARACTER-STREAM OUTPUT-STREAM)
  (:DOCUMENTATION :MIXIN "Output stream with :LINE-OUT.
Used for buffered and unbuffered streams."))

(DEFMETHOD (LINE-OUTPUT-STREAM-MIXIN :LINE-OUT) (LINE &OPTIONAL (START 0) END)
  (FUNCALL-SELF ':STRING-OUT LINE START END)
  (FUNCALL-SELF ':TYO #\CR))

(DEFFLAVOR BUFFERED-LINE-INPUT-STREAM () (CHARACTER-STREAM BUFFERED-INPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "Input stream with buffering and :LINE-IN."))

(COMMENT
(DEFMETHOD (BUFFERED-LINE-INPUT-STREAM :LINE-IN) (&OPTIONAL LEADER)
  (LOOP WITH LENGTH-SO-FAR = 0
	 AND LINE = (MAKE-ARRAY 80 ':TYPE 'ART-STRING
				   ':LEADER-LENGTH (AND (NUMBERP LEADER) LEADER))
	UNLESS (AND STREAM-INPUT-BUFFER
		    (< STREAM-INPUT-INDEX STREAM-INPUT-LIMIT))
	  ;Out of buffer, get another one
	  DO (FUNCALL-SELF ':SETUP-NEXT-INPUT-BUFFER)
	UNTIL (NULL STREAM-INPUT-BUFFER) 	;i.e. EOF
	;We have a non-empty buffer, search for CR in it
	AS CR-IDX = (%STRING-SEARCH-CHAR #\CR STREAM-INPUT-BUFFER STREAM-INPUT-INDEX
					 STREAM-INPUT-LIMIT)
	AS AMT = (- (OR CR-IDX STREAM-INPUT-LIMIT) STREAM-INPUT-INDEX)
	;Nconc this many characters onto the end of the line
	WHEN (> (+ AMT LENGTH-SO-FAR) (ARRAY-LENGTH LINE))
	  DO (SETQ LINE (ADJUST-ARRAY-SIZE LINE (+ AMT LENGTH-SO-FAR)))
	DO (COPY-ARRAY-PORTION STREAM-INPUT-BUFFER STREAM-INPUT-INDEX
			         (SETQ STREAM-INPUT-INDEX (+ STREAM-INPUT-INDEX AMT))
			       LINE LENGTH-SO-FAR (SETQ LENGTH-SO-FAR (+ LENGTH-SO-FAR AMT)))
	UNTIL CR-IDX		;i.e. until we saw a CR
	FINALLY
	  ;If we terminated with a CR, advance over it
	  (IF STREAM-INPUT-BUFFER (INCF STREAM-INPUT-INDEX))
	  ;Adjust size and active-length of line
	  (ADJUST-ARRAY-SIZE LINE LENGTH-SO-FAR)
	  (IF (ARRAY-HAS-LEADER-P LINE) (STORE-ARRAY-LEADER LENGTH-SO-FAR LINE 0))
	  (RETURN (VALUES LINE (NULL STREAM-INPUT-BUFFER)))))
);COMMENT

(DEFMETHOD (BUFFERED-LINE-INPUT-STREAM :LINE-IN) (&OPTIONAL LEADER)
  (LOOP NAMED LINE-IN
	;; STRING is not made until needed to avoid calling ADJUST-ARRAY-SIZE except when
	;; strings cross buffer boundaries.
	WITH STRING = NIL
	AND STRING-INDEX = 0
	DO (LOOP UNTIL (AND STREAM-INPUT-BUFFER
			    (< STREAM-INPUT-INDEX STREAM-INPUT-LIMIT))
		 ;Out of input, get some more
		 UNTIL (FUNCALL-SELF ':SETUP-NEXT-INPUT-BUFFER)
		 ;EOF if none that way
		 WHEN (NULL STRING)
		   DO (SETQ STRING (MAKE-ARRAY STRING-INDEX
					       ':TYPE 'ART-STRING
					       ':LEADER-LENGTH (AND (NUMBERP LEADER) LEADER)))
		 WHEN (NUMBERP LEADER)
		   DO (STORE-ARRAY-LEADER STRING-INDEX STRING 0)
		 DO (RETURN-FROM LINE-IN (VALUES STRING T)))
	;; Now see if this buffer has a CR, and copy out the appropriate amount
	AS CR-INDEX = (%STRING-SEARCH-CHAR #\CR STREAM-INPUT-BUFFER STREAM-INPUT-INDEX
					   STREAM-INPUT-LIMIT)
	WITH NEW-STRING-INDEX AND NEW-BUFFER-INDEX
	WHEN (NOT (NULL CR-INDEX))
;	  WHEN (AND (NULL STRING) (NULL LEADER))
;	    DO (SETQ STRING (LET ((ARRAY STREAM-INPUT-BUFFER)
;				  (OFFSET STREAM-INPUT-INDEX))
;			      (AND (ARRAY-INDEXED-P ARRAY)
;				   (SETQ OFFSET (+ OFFSET (%P-CONTENTS-OFFSET ARRAY 3))
;					 ARRAY (%P-CONTENTS-OFFSET ARRAY 1)))
;			      (MAKE-ARRAY (- CR-INDEX STREAM-INPUT-INDEX)
;					  ':TYPE 'ART-STRING
;					  ':DISPLACED-TO ARRAY
;					  ':DISPLACED-INDEX-OFFSET OFFSET))
;		     STREAM-INPUT-INDEX (1+ CR-INDEX))
;	       (RETURN (VALUES STRING NIL))
;	  ELSE
	  DO (SETQ NEW-BUFFER-INDEX (1+ CR-INDEX)
		   NEW-STRING-INDEX (+ STRING-INDEX (- CR-INDEX STREAM-INPUT-INDEX)))
	ELSE DO (SETQ NEW-BUFFER-INDEX STREAM-INPUT-LIMIT
		      NEW-STRING-INDEX (+ STRING-INDEX
					  (- STREAM-INPUT-LIMIT STREAM-INPUT-INDEX)))
	WHEN (NULL STRING)
	;;Make a string to return or save the end of this packet in.
	  DO (SETQ STRING (MAKE-ARRAY NEW-STRING-INDEX
				      ':TYPE 'ART-STRING
				      ':LEADER-LENGTH (AND (NUMBERP LEADER) LEADER)))
	;;Was some stuff from previous packet, make room.
	ELSE DO (ADJUST-ARRAY-SIZE STRING NEW-STRING-INDEX)
	DO (COPY-ARRAY-PORTION STREAM-INPUT-BUFFER STREAM-INPUT-INDEX NEW-BUFFER-INDEX
			       STRING STRING-INDEX NEW-STRING-INDEX)
	   (SETQ STREAM-INPUT-INDEX NEW-BUFFER-INDEX
		 STRING-INDEX NEW-STRING-INDEX)
	WHEN (NOT (NULL CR-INDEX))	;This buffer is enough to satisfy
	DO (AND (NUMBERP LEADER) (STORE-ARRAY-LEADER STRING-INDEX STRING 0))
	   (RETURN (VALUES STRING NIL))))

;;; Less basic stream flavors
(DEFFLAVOR ASCII-TRANSLATING-INPUT-STREAM-MIXIN
	() ()
  (:REQUIRED-METHODS :TYI)
  (:INCLUDED-FLAVORS INPUT-STREAM)
  (:DOCUMENTATION :MIXIN "An input stream that translates characters from ASCII into lisp machine character set for :TYI method."))

(DEFWRAPPER (ASCII-TRANSLATING-INPUT-STREAM-MIXIN :TYI) (IGNORE . BODY)
  `(PROGN
     .DAEMON-CALLER-ARGS.			;Prevent compiler warnings
     (TYI-FROM-ASCII-STREAM #'(LAMBDA (&REST .DAEMON-CALLER-ARGS.) . ,BODY))))

(DEFUN TYI-FROM-ASCII-STREAM (ASCII-STREAM &AUX CH)
  (SELECTQ (SETQ CH (FUNCALL ASCII-STREAM ':TYI))
    (10 #\BS)
    (11 #\TAB)
    (12 #\LINE)
    (14 #\FF)
    (15
     (LET ((CH1 (FUNCALL ASCII-STREAM ':TYI)))
       (OR (= CH1 12) (FUNCALL ASCII-STREAM ':UNTYI CH1)))
     #\CR)
    (177 #\RUBOUT)
    (T CH)))

(DEFFLAVOR ASCII-TRANSLATING-OUTPUT-STREAM-MIXIN
	() ()
  (:REQUIRED-METHODS :TYO)
  (:INCLUDED-FLAVORS OUTPUT-STREAM)
  (:DOCUMENTATION :MIXIN "An output stream that translates characters from lisp machine character set into ASCII for :TYO method."))

(DEFWRAPPER (ASCII-TRANSLATING-OUTPUT-STREAM-MIXIN :TYO) ((CH) . BODY)
  `(TYO-TO-ASCII-STREAM #'(LAMBDA (&REST .DAEMON-CALLER-ARGS.) . ,BODY) CH))

(DEFUN TYO-TO-ASCII-STREAM (ASCII-STREAM CH)
  (FUNCALL ASCII-STREAM ':TYO
	   (SELECTQ CH
	     (#\BS 10)
	     (#\TAB 11)
	     (#\LINE 12)
	     (#\FF 14)
	     (#\CR
	      (FUNCALL ASCII-STREAM ':TYO 15)
	      12)
	     (#\RUBOUT 177)
	     (T CH))))

(DEFFLAVOR INPUT-POINTER-REMEMBERING-MIXIN
	((INPUT-POINTER-BASE 0)
	 (STREAM-INPUT-LOWER-LIMIT 0))
	()
  (:INCLUDED-FLAVORS BASIC-BUFFERED-INPUT-STREAM)
  ;; :SET-BUFFER-POINTER is sent when a :SET-POINTER request goes beyond the current buffer.
  ;; It should return the real position set and arrange for the next :NEXT-INPUT-BUFFER
  ;; to contain the desired position in it someplace.
  (:REQUIRED-METHODS :SET-BUFFER-POINTER)
  (:DOCUMENTATION :MIXIN "Buffered input stream with :SET-POINTER and :READ-POINTER methods."
		  ))

(DEFMETHOD (INPUT-POINTER-REMEMBERING-MIXIN :SET-BUFFER-POINTER) (NEW-POINTER)
  (FERROR NIL "Cannot set pointer on ~S to ~D" SELF NEW-POINTER))

;;; Obsolete shorthand message, but in the manual, so keep for a while.
(DEFMETHOD (INPUT-POINTER-REMEMBERING-MIXIN :REWIND) ()
  (FUNCALL-SELF ':SET-POINTER 0))

(DEFMETHOD (INPUT-POINTER-REMEMBERING-MIXIN :SET-POINTER) (NEW-POINTER)
  (LOOP AS NEW-RELATIVE-POINTER = (+ (- NEW-POINTER INPUT-POINTER-BASE)
				     STREAM-INPUT-LOWER-LIMIT)
	WHEN (AND STREAM-INPUT-INDEX (= NEW-RELATIVE-POINTER STREAM-INPUT-INDEX))
	RETURN T				;Fast check
	UNTIL (IF STREAM-INPUT-BUFFER
		  (AND ( NEW-RELATIVE-POINTER STREAM-INPUT-LOWER-LIMIT)
		       (< NEW-RELATIVE-POINTER STREAM-INPUT-LIMIT))
		  (= NEW-RELATIVE-POINTER STREAM-INPUT-LOWER-LIMIT))
	DO (FUNCALL-SELF ':DISCARD-CURRENT-INPUT-BUFFER)
	   (SETQ INPUT-POINTER-BASE (FUNCALL-SELF ':SET-BUFFER-POINTER NEW-POINTER))
	   (FUNCALL-SELF ':SETUP-NEXT-INPUT-BUFFER)
	FINALLY (SETQ STREAM-INPUT-INDEX NEW-RELATIVE-POINTER)))

(DEFMETHOD (INPUT-POINTER-REMEMBERING-MIXIN :BEFORE :DISCARD-INPUT-BUFFER) (IGNORE)
  (INCF INPUT-POINTER-BASE (- STREAM-INPUT-INDEX STREAM-INPUT-LOWER-LIMIT))
  (SETQ STREAM-INPUT-LOWER-LIMIT STREAM-INPUT-INDEX))

(DEFMETHOD (INPUT-POINTER-REMEMBERING-MIXIN :AFTER :SETUP-NEXT-INPUT-BUFFER)
	   (&OPTIONAL IGNORE)
  (AND STREAM-INPUT-BUFFER
       (SETQ STREAM-INPUT-LOWER-LIMIT STREAM-INPUT-INDEX)))

(DEFMETHOD (INPUT-POINTER-REMEMBERING-MIXIN :READ-POINTER) ()
  (+ INPUT-POINTER-BASE (IF STREAM-INPUT-INDEX
			    (- STREAM-INPUT-INDEX STREAM-INPUT-LOWER-LIMIT)
			    0)))

(DEFFLAVOR OUTPUT-POINTER-REMEMBERING-MIXIN
	((OUTPUT-POINTER-BASE 0)
	 STREAM-OUTPUT-LOWER-LIMIT)
	()
  (:SETTABLE-INSTANCE-VARIABLES OUTPUT-POINTER-BASE)
  (:INCLUDED-FLAVORS BASIC-BUFFERED-OUTPUT-STREAM)
  (:DOCUMENTATION :MIXIN "Buffered output stream with :READ-POINTER method."))

(DEFMETHOD (OUTPUT-POINTER-REMEMBERING-MIXIN :BEFORE :SEND-OUTPUT-BUFFER) (IGNORE IGNORE)
  (INCF OUTPUT-POINTER-BASE (- STREAM-OUTPUT-INDEX STREAM-OUTPUT-LOWER-LIMIT))
  (SETQ STREAM-OUTPUT-LOWER-LIMIT STREAM-OUTPUT-INDEX))

(DEFMETHOD (OUTPUT-POINTER-REMEMBERING-MIXIN :AFTER :SETUP-NEW-OUTPUT-BUFFER) ()
  (SETQ STREAM-OUTPUT-LOWER-LIMIT STREAM-OUTPUT-INDEX))

(DEFMETHOD (OUTPUT-POINTER-REMEMBERING-MIXIN :READ-POINTER) ()
  (+ OUTPUT-POINTER-BASE (IF STREAM-OUTPUT-INDEX
			    (- STREAM-OUTPUT-INDEX STREAM-OUTPUT-LOWER-LIMIT)
			    0)))

;;; Some useful combinations
(DEFFLAVOR BUFFERED-INPUT-CHARACTER-STREAM ()
	   (INPUT-POINTER-REMEMBERING-MIXIN BUFFERED-LINE-INPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "A buffered input character stream, gives :LINE-IN."))

(DEFFLAVOR BUFFERED-OUTPUT-CHARACTER-STREAM ()
	   (LINE-OUTPUT-STREAM-MIXIN CHARACTER-STREAM BUFFERED-OUTPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "A buffered output character stream, gives :LINE-OUT."))

(DEFFLAVOR BUFFERED-CHARACTER-STREAM ()
	   (BIDIRECTIONAL-STREAM INPUT-POINTER-REMEMBERING-MIXIN BUFFERED-LINE-INPUT-STREAM
	    LINE-OUTPUT-STREAM-MIXIN BUFFERED-OUTPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "A bidrection character stream, :LINE-IN and :LINE-OUT."))

(DEFFLAVOR BUFFERED-STREAM ()
	   (BIDIRECTIONAL-STREAM BUFFERED-INPUT-STREAM BUFFERED-OUTPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "A bidirection buffered stream."))

(DEFFLAVOR BUFFERED-TYI-INPUT-STREAM ()
	   (INPUT-POINTER-REMEMBERING-MIXIN UNBUFFERED-LINE-INPUT-STREAM
	    BASIC-BUFFERED-INPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "A buffered character input stream for use with :TYI wrappers."))

(DEFFLAVOR BUFFERED-TYO-OUTPUT-STREAM ()
	   (LINE-OUTPUT-STREAM-MIXIN CHARACTER-STREAM BASIC-BUFFERED-OUTPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "A buffered character output stream for use with :TYO wrappers."))

(DEFFLAVOR BUFFERED-TYI-TYO-STREAM ()
	   (BIDIRECTIONAL-STREAM INPUT-POINTER-REMEMBERING-MIXIN UNBUFFERED-LINE-INPUT-STREAM
	    BASIC-BUFFERED-INPUT-STREAM LINE-OUTPUT-STREAM-MIXIN BASIC-BUFFERED-OUTPUT-STREAM)
  (:DOCUMENTATION :COMBINATION "A bidirectional buffered character stream, for use with :TYI and :TYO wrappers."))

;;; Flavors for use with file computers

;;; For use with :PROBE OPEN calls
(DEFFLAVOR FILE-STREAM-MIXIN
	(PATHNAME)
	()
  (:INCLUDED-FLAVORS STREAM)
  (:REQUIRED-METHODS :TRUENAME :PLIST)
  (:INITABLE-INSTANCE-VARIABLES PATHNAME)
  (:GETTABLE-INSTANCE-VARIABLES PATHNAME)
  (:DOCUMENTATION :MIXIN "Streams for use with file computers, as returned by OPEN."))

(DEFMETHOD (FILE-STREAM-MIXIN :PRINT-SELF) (STREAM IGNORE IGNORE)
  (SI:PRINTING-RANDOM-OBJECT (SELF STREAM)
    (PRINC (TYPEP SELF) STREAM)
    (FUNCALL STREAM ':TYO #\SP)
    (PRIN1 (STRING PATHNAME) STREAM)))

(DEFMETHOD (FILE-STREAM-MIXIN :GET) (INDICATOR)
  (LET ((PLIST (FUNCALL-SELF ':PLIST)))
    (GET (LOCF PLIST) INDICATOR)))

(DEFMETHOD (FILE-STREAM-MIXIN :CREATION-DATE) ()
  (FUNCALL-SELF ':GET ':CREATION-DATE))

(DEFMETHOD (FILE-STREAM-MIXIN :INFO) ()
  (CONS (FUNCALL-SELF ':TRUENAME) (FUNCALL-SELF ':CREATION-DATE)))

;;; For use with :READ and :WRITE OPEN calls
(DEFFLAVOR FILE-DATA-STREAM-MIXIN
	()
	(FILE-STREAM-MIXIN)
  (:INCLUDED-FLAVORS STREAM)
  (:REQUIRED-METHODS :READ-POINTER :LENGTH :QFASLP)
  (:DOCUMENTATION :MIXIN "Streams which can actually do file I/O."))

(DEFMETHOD (FILE-DATA-STREAM-MIXIN :AFTER :INIT) (IGNORE)
  (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':ADD-STREAM SELF))

(DEFMETHOD (FILE-DATA-STREAM-MIXIN :AFTER :CLOSE) (&OPTIONAL IGNORE)
  (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':DELETE-STREAM SELF))

(DEFMETHOD (FILE-DATA-STREAM-MIXIN :WHO-LINE-INFORMATION) (&AUX COUNT LENGTH PERCENT)
  (SETQ COUNT (FUNCALL-SELF ':READ-POINTER))
  (AND (SETQ LENGTH (FUNCALL-SELF ':LENGTH))
       (NOT (ZEROP LENGTH))
       (SETQ PERCENT (// (* 100. COUNT) LENGTH)))
  (VALUES (FUNCALL-SELF ':PATHNAME) (FUNCALL-SELF ':DIRECTION) COUNT PERCENT))

(DEFFLAVOR INPUT-FILE-STREAM-MIXIN
	()
	(FILE-DATA-STREAM-MIXIN)
  (:INCLUDED-FLAVORS INPUT-POINTER-REMEMBERING-MIXIN)
  (:DOCUMENTATION :MIXIN "Streams for use with input files."))

(DEFFLAVOR OUTPUT-FILE-STREAM-MIXIN
	()
	(FILE-DATA-STREAM-MIXIN)
  (:INCLUDED-FLAVORS OUTPUT-POINTER-REMEMBERING-MIXIN)
  (:DOCUMENTATION :MIXIN "Streams for use with output files."))

(DEFMETHOD (OUTPUT-FILE-STREAM-MIXIN :LENGTH) () NIL)