;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.77
;;; Reason:
;;;  You could try to :untyi past the beginning of a string-input-stream
;;; Written 18-Jun-88 16:48:41 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Cthulhu from band 1
;;; with Experimental System 124.75, Experimental Local-File 74.2, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.0, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, microcode 1760, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.IO; QIO.LISP#233 at 18-Jun-88 16:48:42
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; QIO  "

(defun make-string-input-stream (string &optional (start 0) end)
  "Return a stream from which one can read the characters of STRING, or some substring of it.
START and END are indices specifying a substring of STRING;
they default to 0 and NIL (NIL for END means the end of STRING)."
  (let* ((pointer start)
	 (length (string-length string))
	 (end (or end length))
	 (me nil))
    (setq me #'(lambda (operation &optional arg1 &rest args)
		 (labels ((check-eof (error)
			    (when (or (>= pointer length) (>= pointer end))
			      (if error
				  (signal 'sys:end-of-file :format-string "End of File on string input stream")
				t)))
			  )
		   (selectq-with-which-operations operation
		     ((:close))
		     ((:tyi :any-tyi)
		      (unless (check-eof arg1)
			(prog1 (aref string pointer)
			       (incf pointer))))
		     ((:tyipeek)
		      (unless (check-eof arg1)
			(aref string pointer)))
		     ((:untyi)
		      (if (and (> pointer start) (eq (int-char arg1) (char string (1- pointer))))
			  (decf pointer)
			(ferror nil "Attempt to :UNTYI something different than last :TYI'ed.")))
		     ((:pointer :get-string-index)
		      pointer)
		     ((:set-pointer)
		      (setq pointer arg1))
		     (otherwise
		      (stream-default-handler me operation arg1 args))))))))

))