;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 121.17
;;; Reason:
;;;  SI::VARIABLE-GLOBALLY-SPECIAL-P
;;;  Make patches obey system default binary file type (and break up
;;;   LOAD-PATCHES in the process).
;;;  PRINT-SYSTEM-MODIFICATIONS output is a little less cluttered.
;;;  Give a ``give up'' handler for MAKE-SYSTEM.
;;; Written 29-Jan-87 16:13:11 by RpK (Robert P. Krajewski) at site LMI Cambridge
;;; while running on Cthulhu from band 3
;;; with Experimental System 121.15, 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, Experimental Site Data Editor 4.0, Experimental K Bridge Support 1.0, microcode 1730, SDU Boot Tape 3.12, SDU ROM 102, the old ones.



; From modified file DJ: L.SYS; EVAL.LISP#170 at 29-Jan-87 16:13:14
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; EVAL  "


(defparameter variable-special-properties '(special system-constant))

(defsubst variable-globally-special-p (variable)
  ;; VARIABLE is assumed to be a symbol.
  (getl variable variable-special-properties))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#200 at 29-Jan-87 16:29:26
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "


(defsubst system-default-binary-file-type (system)
  (getf (system-plist system) 'default-binary-file-type :qfasl))

(defun make-system-binary-pathname (system pathname)
  (send pathname :new-type (system-default-binary-file-type system)))

))

; From modified file DJ: L.SYS2; PATCH.LISP#180 at 29-Jan-87 16:38:11
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "

(defun patch-system (patch-system)
  (find-system-named (patch-name patch-system)))

))

; From modified file DJ: L.SYS2; PATCH.LISP#180 at 29-Jan-87 17:21:19
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "


(defun load-patch-file (filename verbose-p)
  ;; I wish I could put the following hack in when the patch is being written.
  ;; Anyway, too many times, people make patches that reload files,
  ;; then the files get recompiled and do bizzare things.  For example,
  ;; my 110 band is now useless now that 115 has incompatable qfasl's.
  ;; Therefore, I institute this policy of not allowing random qfasl's
  ;; to be loaded by a patch.  If you want to do that, Add Patch the 
  ;; whole file.  This will also break the technique of using System patchs to load
  ;; other systems.   - Pace
  (let ((real-load #'load))
    (letf (((symbol-function 'load) #'(lambda (&rest ignore)
					(ferror nil "The use of ~S in a patch file is not supported." 'load))))
      (funcall real-load filename :verbose verbose-p :set-default-pathname nil))))

(defun load-patches-for-systems (system-names selective-p verbose-p unreleased-p force-through-unfinished-patches-p)
  (LET ((FIRST-SYSTEM T) (something-changed nil))  ; This is the first system being patched.
    (DOLIST (PATCH SYSTEM-NAMES)
      (CATCH-ERROR-RESTART (ERROR "Give up on patches for ~A." (CAR PATCH))
	(LET* ((PATCH-DIR (READ-PATCH-DIRECTORY PATCH T))
	       (NEW-VERS (PATCH-DIR-VERSION-LIST PATCH-DIR))
	       (MAJOR (PATCH-VERSION PATCH))
	       (binary-file-type (system-default-binary-file-type (patch-system patch)))
	       PATCHES-NOT-LOADED
	       (CHANGE-STATUS T)		;Ok to change the system status
	       (UNRELEASED-CONSIDERED NIL)	;T if considering unreleased patches.
	       (PATCH-SKIPPED NIL)	;T if considering patches after skipping one.
	       (PROCEED-FLAG (NOT SELECTIVE-P))) ; Has the user said to proceed?
	  (IF (AND (NULL PATCH-DIR) VERBOSE-P)
	      (FORMAT T "~&Skipping system ~A, whose patch directory cannot be accessed.~%"
		      (CAR PATCH))
	    (progn
	      ;; Get list of patches of this system not already loaded.
	      (SETQ PATCHES-NOT-LOADED
		    (CDR (MEMASSQ (VERSION-NUMBER (FIRST (PATCH-VERSION-LIST PATCH)))
				  NEW-VERS)))
	      ;; Maybe announce the system.
	      (WHEN (AND PATCHES-NOT-LOADED VERBOSE-P)	;verbose and silent is nonsense
		(FRESH-LINE *STANDARD-OUTPUT*)
		(UNLESS FIRST-SYSTEM (TERPRI))
		(FORMAT T "~&Patches for ~A (Current version is ~D.~D):"
			(PATCH-NAME PATCH) MAJOR (CAAR (LAST NEW-VERS))))
	      (DOLIST (VERSION PATCHES-NOT-LOADED)
		(LET* ((FILENAME (PATCH-SYSTEM-PATHNAME (PATCH-NAME PATCH) :PATCH-FILE
							(PATCH-VERSION PATCH)
							(VERSION-NUMBER VERSION)
							binary-file-type)))
		  ;; NIL is used to mark patches that are reserved, but not finished.
		  ;; We can't load any more patches without this one, in order to
		  ;; make sure that any two systems claiming to be version xx.yy
		  ;; always have exactly the same set of patches loaded.  Punt.
		  ;; If someone forgets to finish a patch, we assume a hacker will
		  ;; eventually see what is happening and fix the directory to unstick
		  ;; things.  We might at least say the patches are unfinished.
		  (UNLESS (VERSION-EXPLANATION VERSION)
		    (WHEN VERBOSE-P
		      (FORMAT T "~&There are unfinished patches in ~A."
			      (PATCH-NAME PATCH)))
		    (UNLESS FORCE-THROUGH-UNFINISHED-PATCHES-P
		      (RETURN)))
		  (WHEN (VERSION-UNRELEASED VERSION)
		    (WHEN VERBOSE-P
		      (FORMAT T "~&There are unreleased patches in ~A."
			      (PATCH-NAME PATCH)))
		    (OR
		      FORCE-THROUGH-UNFINISHED-PATCHES-P 
		      UNRELEASED-P
		      UNRELEASED-CONSIDERED
		      (EQ (PATCH-STATUS PATCH) :INCONSISTENT)
		      (AND SELECTIVE-P
			   (WITH-TIMEOUT ((* 5 60. 60.)
					  (FORMAT T " -- timed out, No.")
					  NIL)
			     (FORMAT T "~&Such patches are subject to change; therefore,
  you should not load them if you are going to dump a band.
  If you are not going to dump a band, it is reasonable
  to load these patches to benefit from the improvements in them.")
			     (SETQ PROCEED-FLAG NIL)
			     (Y-OR-N-P "Consider the unreleased patches? (Automatic No after 5 minutes) ")))
		      (RETURN))
		    (SETQ UNRELEASED-CONSIDERED T))
		  (WHEN VERBOSE-P
		    (PRINT-PATCH (PATCH-VERSION PATCH) VERSION))
		  (SELECTQ-EVERY
		    (COND (PROCEED-FLAG)
			  (T (WITH-TIMEOUT ((* 5 60. 60.)
					    (FORMAT T " -- timed out, Proceed.")
					    'PROCEED)
			       (FQUERY '(:CHOICES (((T "Yes.") #\Y #\SP #\T #\HAND-UP)
						   ((NIL "No.") #\N #\RUBOUT #\HAND-DOWN)
						   ((PROCEED "Proceed.") #\P)))
				       "Load? (Automatic Proceed after 5 minutes) "))))
		    (NIL
		     ;; "No", don't load any more for this system.
		     ;; Also don't change the status.
		     ;; Except, if we are considering unreleased patches,
		     ;; loading out of order is no worse than loading unreleased
		     ;; patches in the first place, so keep on offering.
		     (SETQ CHANGE-STATUS NIL)
		     (UNLESS (OR FORCE-THROUGH-UNFINISHED-PATCHES-P
				 UNRELEASED-CONSIDERED)
		       (RETURN NIL))
		     (WHEN (EQ VERSION (CAR (LAST PATCHES-NOT-LOADED)))
		       ;; Don't give a spiel about following patches
		       ;; if there are none.
		       (RETURN NIL))
		     (UNLESS (OR PATCH-SKIPPED
				 (EQ (PATCH-STATUS PATCH) ':INCONSISTENT))
		       (FORMAT T "~&If you load any following patches for this system,
  they will be out of sequence, so you must not dump a band.")
		       (SETQ PATCH-SKIPPED T)))
		    (PROCEED
		     ;; "Proceed" with the rest for this system.
		     (SETQ PROCEED-FLAG T))
		    ((T PROCEED)
		     ;; "Yes" or "Proceed", do this one.
		     (SETQ SOMETHING-CHANGED T)
		     ;; Unfinished, unreleased or out of sequence =>
		     ;;  mark system as inconsistent.
		     (WHEN (OR PATCH-SKIPPED
			       (NULL (VERSION-EXPLANATION VERSION))
			       (VERSION-UNRELEASED VERSION))
		       (UNLESS (EQ (PATCH-STATUS PATCH) ':INCONSISTENT)
			 (SETF (PATCH-STATUS PATCH) ':INCONSISTENT)
			 (FORMAT T "~&~A is now inconsistent; do not dump a band."
				 (PATCH-NAME PATCH))))
		     ;; Avoid error if non ex file, if patch is known to be unfinished.
		     (CONDITION-CASE-IF (NULL (VERSION-EXPLANATION VERSION)) ()
			 (load-patch-file filename verbose-p)
		       (FS:FILE-NOT-FOUND
			(WHEN VERBOSE-P
			  (FORMAT T "~&File ~A does not exist, ignoring this patch."
				  FILENAME))))
		     (PUSH VERSION (PATCH-VERSION-LIST PATCH))))))
	      (AND CHANGE-STATUS
		   (NEQ (PATCH-STATUS PATCH) ':INCONSISTENT)
		   (LET ((NEW-STATUS (PATCH-DIR-STATUS PATCH-DIR)))
		     (COND ((NEQ (PATCH-STATUS PATCH) NEW-STATUS)
			    (SETQ SOMETHING-CHANGED T)
			    (WHEN VERBOSE-P
			      (FORMAT T "~&~A is now ~A."
				      (PATCH-NAME PATCH)
				      (FOURTH (ASSQ NEW-STATUS
						    SYSTEM-STATUS-ALIST))))
			    ;; Update the status.
			    (SETF (PATCH-STATUS PATCH) NEW-STATUS)))))))))
      (SETQ FIRST-SYSTEM NIL))
    something-changed))

;; lad and dj versions merged 10/5/86 -rpp
(DEFUN LOAD-PATCHES (&REST OPTIONS &AUX TEM SOMETHING-CHANGED)
  "Load any new patches for one or more systems.
Options can include these symbols:
 :NOSELECTIVE - don't ask about each patch.
 :SILENT or :NOWARN - don't print out any information on loading patches
   (and also don't ask).
 :VERBOSE - says to print out information about loading each patch.
   This is the default and is only turned off by :silent and :nowarn.
 :UNRELEASED - says to load or consider unreleased patches.
   Once unreleased patches have been loaded, a band may not be dumped.
 :FORCE-UNFINISHED - load all patches that have not been finished yet,
   if they have QFASL files.  This is good for testing patches.
 :NOOP - do nothing
 :SITE - load latest site configuration info.
 :NOSITE - do not load latest site configuration info.
   :SITE is the default unless systems to load patches for are specified.

Options can also include :SYSTEMS followed by a list of systems to load patches for.
One or more names of systems are also allowed.

LOAD-PATCHES returns T if any patches were loaded, otherwise NIL."
  (CATCH-ERROR-RESTART (SYS:REMOTE-NETWORK-ERROR
			 "Give up on trying to load patches.")
    (LET ((SYSTEM-NAMES NIL)			;A-list of systems to load patches for.
	  (SELECTIVE-P T)			;Ask the user.
	  (VERBOSE-P T)				;Tell the user what's going on.
	  (UNRELEASED-P NIL)
	  (SITE-SPECIFIED-P NIL)
	  (SITE-P T)
	  (FORCE-THROUGH-UNFINISHED-PATCHES-P NIL))
      (DO ((OPTS OPTIONS (CDR OPTS)))
	  ((NULL OPTS))
	(SELECTQ (CAR OPTS)
	  (:SYSTEMS
	   (SETQ OPTS (CDR OPTS))
	   (SETQ SYSTEM-NAMES
		 (IF (CONSP (CAR OPTS))
		     (MAPCAR #'GET-PATCH-SYSTEM-NAMED (CAR OPTS))
		   (LIST (GET-PATCH-SYSTEM-NAMED (CAR OPTS)))))
	   (UNLESS SITE-SPECIFIED-P
	     (SETQ SITE-P NIL)))
	  ((:SILENT :NOWARN) (SETQ VERBOSE-P NIL SELECTIVE-P NIL))
	  (:VERBOSE (SETQ VERBOSE-P T))
	  (:SELECTIVE (SETQ SELECTIVE-P T))
	  (:SITE (SETQ SITE-P T SITE-SPECIFIED-P T))
	  (:NOOP NIL)
	  (:NOSITE (SETQ SITE-P NIL SITE-SPECIFIED-P T))
	  (:UNRELEASED (SETQ UNRELEASED-P T))
	  (:NOSELECTIVE (SETQ SELECTIVE-P NIL))
	  (:FORCE-UNFINISHED (SETQ FORCE-THROUGH-UNFINISHED-PATCHES-P T))
	  (OTHERWISE
	    (COND ((AND (OR (SYMBOLP (CAR OPTS)) (STRINGP (CAR OPTS)))
			(SETQ TEM (GET-PATCH-SYSTEM-NAMED (CAR OPTS) T)))
		   (PUSH TEM SYSTEM-NAMES)
		   (UNLESS SITE-SPECIFIED-P
		     (SETQ SITE-P NIL)))
		  (T (FERROR "~S is neither a ~S option nor a system name."
				 (CAR OPTS) 'LOAD-PATCHES))))))
      (WITH-SYS-HOST-ACCESSIBLE
	(LET-IF VERBOSE-P ((TV:MORE-PROCESSING-GLOBAL-ENABLE NIL))
	  (WHEN SITE-P
	    (WHEN VERBOSE-P
	      (FORMAT T "~%Checking whether site configuration has changed..."))
	    (IF (IF SELECTIVE-P
		    (MAKE-SYSTEM "SITE" :NO-RELOAD-SYSTEM-DECLARATION)
		  (IF VERBOSE-P
		      (MAKE-SYSTEM "SITE" :NOCONFIRM :NO-RELOAD-SYSTEM-DECLARATION)
		      (MAKE-SYSTEM "SITE" :NOCONFIRM :NO-RELOAD-SYSTEM-DECLARATION :SILENT)))
		(SETQ SOMETHING-CHANGED T)
	      (WHEN VERBOSE-P (FORMAT T "  it hasn't.")))
	    (LOAD-PATCHES-FOR-LOGICAL-PATHNAME-HOSTS))
	  (OR SYSTEM-NAMES (SETQ SYSTEM-NAMES (SUBSET #'(LAMBDA (X)
							  (NOT (MEMQ X FROZEN-PATCH-SYSTEMS-LIST)))
						      PATCH-SYSTEMS-LIST)))
	  (DOLIST (X SYSTEM-NAMES)
	    (WHEN (MEMQ X FROZEN-PATCH-SYSTEMS-LIST)
	      (FORMAT T "~&Note: Patch System ~S is frozen. There should be no need to load patches from it.~%"
		      (PATCH-NAME X))))
	  (setq something-changed (or (load-patches-for-systems system-names selective-p verbose-p unreleased-p
								force-through-unfinished-patches-p)
				      something-changed))))))
  SOMETHING-CHANGED)

))

; From modified file DJ: L.SYS2; PATCH.LISP#180 at 29-Jan-87 17:28:34
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "


(DEFUN PRINT-PATCH (MAJOR-VERSION-NUMBER PATCH-VERSION-DESC)
  (FORMAT T "~&~D.~D ~8T~A:~:[~; (unreleased)~]~&~10T~~A~~%"
	  MAJOR-VERSION-NUMBER
	  (VERSION-NUMBER PATCH-VERSION-DESC)
	  (VERSION-AUTHOR PATCH-VERSION-DESC)
	  (VERSION-UNRELEASED PATCH-VERSION-DESC)
	  (VERSION-EXPLANATION PATCH-VERSION-DESC)))

(DEFUN PRINT-PATCHES (&OPTIONAL (SYSTEM "System") (AFTER 0))
  "Print the patches of the system SYSTEM after minor version AFTER."
  (LET* ((PATCH-SYSTEM (GET-PATCH-SYSTEM-NAMED SYSTEM T T))
	 (VERSION (PATCH-VERSION PATCH-SYSTEM))	;efficiency
	 (LATEST (VERSION-NUMBER (CAR (PATCH-VERSION-LIST PATCH-SYSTEM)))))
    (cond ((NULL PATCH-SYSTEM)
	   (FoRMAT T "~%No ~A system loaded~%" SYSTEM))
	  (t
	   (FORMAT T "~%~A ~8TModification:~%" (PATCH-NAME PATCH-SYSTEM))
	   (IF (> AFTER LATEST)
	       (FORMAT T "~&Most recent patch loaded is ~D." LATEST)
	     (DOLIST (V (REVERSE (PATCH-VERSION-LIST PATCH-SYSTEM)))
	       (WHEN ( AFTER (VERSION-NUMBER V))
		 (PRINT-PATCH VERSION V))))))))

))

; From modified file DJ: L.SYS2; PATCH.LISP#180 at 29-Jan-87 17:35:34
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "

(defun make-patch-system-binary-pathname (patch-system pathname)
  (make-system-binary-pathname (patch-system patch-system) pathname))

))

; From modified file DJ: L.SYS2; PATCH.LISP#180 at 29-Jan-87 17:43:16
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "

(defun compile-patch-file (patch-system pathname)
  (compile-file pathname
		:output-file (make-patch-system-binary-pathname patch-system pathname)))

))

; From modified file DJ: L.SYS2; PATCH.LISP#180 at 29-Jan-87 17:45:17
#10R SYSTEM-INTERNALS#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "

(DEFUN CONSUMMATE-PATCH (PATCH-SYSTEM NUMBER MESSAGE &OPTIONAL (RELEASE-FLAG T) NO-RECOMPILE)
  "Finish up making the patch for the specified minor system version number.
MESSAGE is the message to be displayed to the user in PRINT-PATCHES.
This replaces the NILs left by RESERVE-PATCH with the message.
If RELEASE-FLAG is NIL, the patch is not released, so it will
be loaded only by users who say to load unreleased patches.
To release the patch, call CONSUMMATE-PATCH again
 with NIL (or an updated message) for MESSAGE and T for RELEASE-FLAG.
NO-RECOMPILE says do not compile the patch file source;
 this would normally be used only with releasing an already finished patch."
  (UNLESS NO-RECOMPILE
    (COMPILE-patch-FILE patch-system (PATCH-SYSTEM-PATHNAME (PATCH-NAME PATCH-SYSTEM) :PATCH-FILE
							    (PATCH-VERSION PATCH-SYSTEM) NUMBER
							    :LISP)))
  (LET* ((PATCH-DIR (READ-PATCH-DIRECTORY PATCH-SYSTEM))
	 (PATCHES (PATCH-DIR-VERSION-LIST PATCH-DIR))
	 (VERSION (ASSQ NUMBER PATCHES)))
    (IF MESSAGE (SETF (VERSION-EXPLANATION VERSION) MESSAGE))
    (SETF (VERSION-UNRELEASED VERSION) (NOT RELEASE-FLAG))
    (WRITE-PATCH-DIRECTORY PATCH-SYSTEM PATCH-DIR)
    NIL))	;Despite the comment above, this function doesn't seem to detect any

))

; From modified file DJ: L.ZWEI; PATED.LISP#36 at 29-Jan-87 17:48:29
#10R ZWEI#: #!:CL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; PATED  "

(DEFUN FINISH-PATCH (&OPTIONAL (RELEASE-FLAG NIL SPECIFIEDP))
  (VALIDATE-PATCH-BUFFER)
  (COND ((NULL *PATCH-BUFFER*)
	 (BARF "There is no current patch buffer"))
	((NOT SPECIFIEDP)
	 (SETQ RELEASE-FLAG
	       (FQUERY ()
		       "Release this patch? (answer N if you have not completely sure that it works) "))))
  (LET ((DESCRIPTION (TYPEIN-LINE-MULTI-LINE-READLINE
		       "Description of changes (end with ~C)" #\END)))
    (SETQ DESCRIPTION (STRING-TRIM '(#\NEWLINE) DESCRIPTION))
    (LET ((BP (FORWARD-LINE (INTERVAL-FIRST-BP *PATCH-BUFFER*) 2)))
      (INSERT-MOVING BP ";;; Reason:")
      (INSERT-MOVING BP #\NEWLINE)
      (DO ((START 0 (1+ NEXT-LINE))
	   NEXT-LINE)
	  (())
	(SETQ NEXT-LINE (STRING-SEARCH-CHAR #\NEWLINE DESCRIPTION START))
	(INSERT-MOVING BP ";;;  ")
	(INSERT-MOVING BP DESCRIPTION START NEXT-LINE)
	(INSERT-MOVING BP #\NEWLINE)
	(OR NEXT-LINE (RETURN))))
    (SAVE-BUFFER-IF-NECESSARY *PATCH-BUFFER*)
    (WHEN (EQ *PATCH-BUFFER* *INTERVAL*)
      (MUST-REDISPLAY *WINDOW* DIS-TEXT))
    (LET ((ERROR-MESSAGE (IF *PATCH-SYSTEM*
			     (SI::CONSUMMATE-PATCH *PATCH-SYSTEM* *PATCH-NUMBER*
						   DESCRIPTION RELEASE-FLAG)
			   (progn
			     (si::compile-patch-file *patch-system* (buffer-pathname *patch-buffer*))
			     NIL))))
      (cond ((ERRORP ERROR-MESSAGE)
	     (BARF "~A" ERROR-MESSAGE))
	    (t
	     (FORMAT *QUERY-IO* "~&~:[Patch completed.~;Don't forget to save your files!~]"
		     (LOOP FOR BUFFER IN *ZMACS-BUFFER-LIST*
			   THEREIS (BUFFER-NEEDS-SAVING-P BUFFER))
		     (FORMAT *QUERY-IO* "~&Don't forget to save your files!"))
	     (SETQ *PATCH-BUFFER* NIL
		   *PATCH-SYSTEM* NIL))))))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#200 at 29-Jan-87 17:55:15
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFUN MAKE-SYSTEM (SYSTEM &REST KEYWORDS &AUX *SOMETHING-LOADED*)
  "Operate on the files of the system SYSTEM.
Most commonly used to compile or load those files which need it.
Keywords are not followed by values.
Commonly used keywords include:
 :COMPILE - recompile source files.
 :NOLOAD - don't load compiled files.
 :RELOAD - load even files already loaded.
 :RECOMPILE - recompile files already compiled.
 :SELECTIVE - ask user about each file individually.
 :NOCONFIRM - do not ask for confirmation at all.
 :NO-INCREMENT-PATCH - don't increment the patch version number of a patchable system.
 :INCREMENT-PATCH - do increment the patch version number.
 :NO-LOAD-PATCHES - do not load patches for patchable system being loaded.
 :NO-RELOAD-SYSTEM-DECLARATION - don't reload the file that contains the DEFSYSTEM.
 :PRINT-ONLY - don't load or compile anything, just say what needs to be done.
 :DESCRIBE - say when files were compiled or loaded, etc.
 :SILENT - don't print lists of files on the terminal at all.
 :BATCH - write a file containing any warnings produced by compilation.
      Just load the file, as lisp code, to reload the warnings.
 :DO-NOT-DO-COMPONENTS - omit subsystems."
  (catch-error-restart (eh:debugger-condition "Give up on making the ~A system." system)
    ;; Force the system-defining file to get loaded
    ;; before we bind the variables or anything like that.
    (FIND-SYSTEM-NAMED SYSTEM)
    ;; First check whether there is a new system declaration that can be loaded
    (MAYBE-RELOAD-SYSTEM-DECLARATION SYSTEM KEYWORDS)
    (PROGW *MAKE-SYSTEM-SPECIAL-VARIABLES*
      (UNWIND-PROTECT
	  (PROGN
	    (SETQ *SYSTEM-BEING-MADE* (FIND-SYSTEM-NAMED SYSTEM))
	    (SETQ *SYSTEM-DEFAULT-BINARY-FILE-TYPE*
		  (system-default-binary-file-type *SYSTEM-BEING-MADE*))
	    (SETQ *TOP-LEVEL-TRANSFORMATIONS*
		  `(,@*LOAD-TYPE-TRANSFORMATIONS* DO-COMPONENTS-INTERNAL))
	    ;; Do all the keywords
	    (DOLIST (KEYWORD KEYWORDS)
	      (LET ((FUNCTION (GET KEYWORD 'MAKE-SYSTEM-KEYWORD)))
		(OR FUNCTION
		    (FERROR NIL "~S is not a recognized option" KEYWORD))
		(FUNCALL FUNCTION)))
	    ;; Make :NO-INCREMENT-PATCH override :COMPILE even if :COMPILE comes later.
	    (WHEN *NO-INCREMENT-PATCH*
	      (SETQ *TOP-LEVEL-TRANSFORMATIONS*
		    (DEL-IF #'(LAMBDA (X)
				(MEMQ X '(INCREMENT-COMPILED-VERSION)))
			    *TOP-LEVEL-TRANSFORMATIONS*)))
	    ;; Process forms with compiler context
	    (DOLIST (FORM *MAKE-SYSTEM-FORMS-TO-BE-EVALED-BEFORE*)
	      (EVAL FORM))
	    ;; Do the work of the transformations
	    (PERFORM-TRANSFORMATIONS (COLLECT-TOP-LEVEL-TRANSFORMATIONS
				       *SYSTEM-BEING-MADE*))
	    ;; Finally process any forms queued by the keywords with compiler context
	    (DOLIST (FORM *MAKE-SYSTEM-FORMS-TO-BE-EVALED-AFTER*)
	      (EVAL FORM)))
	;; Now forms outside of compiler context
	;; These are done even if there was an error.
	(DOLIST (FORM *MAKE-SYSTEM-FORMS-TO-BE-EVALED-FINALLY*)
	  (EVAL FORM))))
    *SOMETHING-LOADED*))

))