;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 121.50
;;; Reason:
;;;  SI::*READ-BARF-IF-AUTO-EXPORT?* controls whether the reader is allowed
;;;  to intern symbols in an auto-exporting package.
;;; Written 19-Mar-87 13:24:01 by jrm (Joe Marshall) at site LMI Cambridge
;;; while running on Lambda Four A from band 1
;;; with Experimental System 121.49, Experimental Lambda-Diag 15.0, Experimental ZMail 70.2, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, microcode 1742, SDU Boot Tape 3.14, SDU ROM 102, 121.46.



; From modified file DJ: L.IO; READ.LISP#458 at 19-Mar-87 13:24:17
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; READ  "

(defvar *read-barf-if-auto-export?* T
  "T means that the reader is not allowed to intern a symbol in
a package that is auto exporting.  NIL makes the reader pay attention
only to the READ-LOCK feature of the package.")

))

; From modified file DJ: L.IO; READ.LISP#458 at 19-Mar-87 13:24:27
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; READ  "

(DEFUN (:PROPERTY PACKAGE-PREFIX STANDARD-READ-FUNCTION) (STREAM STRING IGNORE)
  (PROG (THING PK
	 ;; Help un-screw the user if *PACKAGE* gets set to NIL.
	 (*PACKAGE* (OR *PACKAGE* PKG-USER-PACKAGE))
	 INTERNAL-OK ENTIRE-LIST-PREFIXED)
	;; Gobble the second colon, if any, and set flag if found.
	;; Note that we do not, currently, DO anything with the flag!
	(MULTIPLE-VALUE-BIND (CH NUM REAL-CH)
	    (XR-XRTYI STREAM NIL T)
	  (IF (= CH #/:)
	      (SETQ INTERNAL-OK T)
	    (IF (= CH #/()
		(SETQ ENTIRE-LIST-PREFIXED T))
	    (XR-XRUNTYI STREAM REAL-CH NUM)))
	;; Try to find the package.
	;;don't try to find packages if we're not interning -- eg #+slime (dis:foo)
	(UNLESS *READ-SUPPRESS*
	  (DO ((STRING1 (OR STRING "")))
	      ((SETQ PK (FIND-PACKAGE STRING1 *PACKAGE*)))
	    ;; Package not found.
	    (SIGNAL-PROCEED-CASE ((PKG) 'READ-PACKAGE-NOT-FOUND
					"Package ~S does not exist."
					STRING1)
	      (:NO-ACTION
	       (RETURN))
	      (:NEW-NAME
	       (LET ((*PACKAGE* PKG-USER-PACKAGE))
		 (SETQ STRING1 (STRING (READ-FROM-STRING PKG)))))
	      (:CREATE-PACKAGE
	       (OR (FIND-PACKAGE STRING1 *PACKAGE*)
		   (MAKE-PACKAGE STRING1))))))
	(OR PK (SETQ PK PKG-USER-PACKAGE))
	(WHEN STRING (RETURN-READ-STRING STRING))
	(LET ((*PACKAGE* PK)
	      (*INHIBIT-READER-SYMBOL-SUBSTITUTION* T)
	      (READ-INTERN-FUNCTION (COND ((OR (AND (PKG-AUTO-EXPORT-P PK)
						    (PACKAGE-USED-BY-LIST PK)
						    *read-barf-if-auto-export?*)
					       (PKG-READ-LOCK-P PK))
					   'READ-INTERN-SOFT)
					  ((OR ENTIRE-LIST-PREFIXED (EQ PK *PACKAGE*))
					   ;; Here for, e.g., SI: while in SI already.
					   ;; Also here for ZWEI:(BP-LINE (POINT));
					   ;; such constructs are not valid Common Lisp
					   ;; so let's keep their meaning the same.
					   READ-INTERN-FUNCTION)
					  ((OR INTERNAL-OK
					       (PKG-AUTO-EXPORT-P PK)
					       (EQ *READ-SINGLE-COLON-ALLOW-INTERNAL-SYMBOL* T))
					   'INTERN)
					  (T
					   'READ-PACKAGE-PREFIX-EXTERNAL-INTERN))))
	  (SETQ THING (INTERNAL-READ STREAM T NIL T)))
	(RETURN (VALUES THING
			(TYPE-OF THING)
			T))))	;T means we already did RETURN-READ-STRING

))