;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.280
;;; Reason:
;;;  Thank you, Bob Kerns, for fixing the compiler bug that caused SI:INTERNAL-READ
;;;  to be mis-compiled.  This patch recompiles that function....
;;; Written 13-May-88 10:22:58 by pld at site Gigamos Cambridge
;;; while running on Azathoth from band 3
;;; with Experimental System 123.279, Experimental Local-File 73.6, Experimental FILE-Server 22.5, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.2, Experimental Lambda-Diag 15.0, Experimental Tape 22.4, microcode 1756, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From file DJ: L.IO; READ.LISP#462 at 13-May-88 10:22:59
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; READ  "

(DEFUN INTERNAL-READ (&OPTIONAL (STREAM *STANDARD-INPUT*)
		      (EOF-ERRORP T) EOF-VALUE RECURSIVE-P
		      PRESERVE-WHITESPACE DISCARD-CLOSEPARENS CHECK-INDENTATION
		      &AUX W-O)
  "Read an s-expression from STREAM and return it.
End of file within an s-expression is an error.
End of file with no s-expression seen is controlled by EOF-ERRORP.
T means it is an error then too.  NIL means that end of file
with no s-expression returns EOF-VALUE.

RECURSIVE-P non-NIL is used for recursive calls, e.g. from read macro definitions.
Recursive calls must be distinguished to make READ-PRESERVING-WHITESPACE
and #n= /"labels/" work properly.

PRESERVE-WHITESPACE if non-NIL says do not discard the terminating delimiter even
if it is whitespace.  This argument is ignored if RECURSIVE-P is non-NIL,
and the outer, nonrecursive call gets to control the matter.

DISCARD-CLOSEPARENS if non-NIL says if we see a close paren
just keep reading past it, with no error.

CHECK-INDENTATION controls whether indentation is checked within this
s-expression.  If RECURSIVE-P is non-NIL, this argument is ignored
and the outer, nonrecursive call gets to control the matter."
  (COND ((EQ STREAM T) (SETQ STREAM *TERMINAL-IO*))
	((EQ STREAM NIL) (SETQ STREAM *STANDARD-INPUT*)))
  (LET-IF (NOT RECURSIVE-P)
	  ((XR-LABEL-BINDINGS NIL)
	   (READ-PRESERVE-DELIMITERS PRESERVE-WHITESPACE)
	   (READ-CHECK-INDENTATION CHECK-INDENTATION)
	   (XR-XRTYI-LAST-CHAR #/RETURN)
	   (XR-XRTYI-PREV-CHAR NIL)
	   (READ-STREAM STREAM)
	   (MISSING-CLOSEPAREN-REPORTED NIL))
    (SETQ W-O (SEND STREAM ':WHICH-OPERATIONS))
    (COND ((MEMQ ':READ W-O)
	   (SEND STREAM ':READ NIL))
;	  ((AND (NOT RECURSIVE-P) (NEQ RUBOUT-HANDLER STREAM) (MEMQ ':RUBOUT-HANDLER W-O))
;	   (WITH-INPUT-EDITING (STREAM '((:ACTIVATION CHAR= #/END)))
;	     (INTERNAL-READ STREAM EOF-ERRORP EOF-VALUE T)))
	  ((PROG (THING TYPE XR-SHARP-ARGUMENT)
	       A (MULTIPLE-VALUE (THING TYPE) (XR-READ-THING STREAM))
		 (COND ((EQ TYPE 'READER-MACRO)
			(LET ((XR-LIST-SO-FAR ':TOPLEVEL)
			      (XR-SPLICE-P NIL)
			      VALUES)
			  (SETQ VALUES (INVOKE-READER-MACRO THING STREAM))
			  (IF (OR XR-SPLICE-P
				  ( (LENGTH VALUES) 1))
			      (GO A))
			  (RETURN (CAR VALUES))))
		       ((EQ TYPE 'SPECIAL-TOKEN)
			(COND ((EQ THING 'EOF)
			       (IF EOF-ERRORP
				   (CERROR :NO-ACTION NIL 'READ-END-OF-FILE
				     "End of file encountered by the reader on stream ~S."
				     STREAM)
				 (RETURN EOF-VALUE)))
			      ((AND DISCARD-CLOSEPARENS
				    (EQ THING 'CLOSE))
			       (GO A))
			      (T
			       (READ-ERROR "The special token ~S was read in at top level."
					   THING))))
		       (T (RETURN THING))))))))

))