;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.38
;;; Reason:
;;;  New MAKE-SYSTEM changes to handle :FOR-FALCON, saving
;;;  and loading environment files, etc.
;;; Written 11-Aug-88 01:35:36 by RWK at site Gigamos Cambridge
;;; while running on Harpo from band 3
;;; with Experimental System 126.37, ZWEI 125.15, ZMail 73.2, Local-File 75.2, File-Server 24.1, Unix-Interface 13.0, Tape 24.2, Lambda-Diag 17.0, microcode 1762, SDU Boot Tape 3.12, SDU ROM 102, kold 4aug88.



; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:35:37
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFUN PATHNAME-DEFAULT-BINARY-FILE-TYPE (PATHNAME)
  "Given a pathname, return the default binary file type (possibly canonical) to use with it.
This is computed from the SYSTEM which the pathname belongs to."
  (OR (SEND (SEND PATHNAME :GENERIC-PATHNAME) :GET :DEFAULT-BINARY-FILE-TYPE)
      (first (get compiler:*target-computer* 'si:make-system))
      (error "Unknown target computer ~S." compiler:*target-computer*)))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:36:06
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(defprop compiler:lambda-interface (:qfasl nil compiler:compile-file) si:make-system)
(defprop compiler:k
	 (:fbin #+(target lambda) :fdef		;When this code runs on the Lambda, in cross-compile mode.
		#-(target lambda) nil		;When this code runs on the Falcon, in native mode.
		compiler:compile-file-for-falcon)
  si:make-system)
))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:36:59
#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 (first (get compiler:*target-computer* 'si:make-system))))

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

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:37:19
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFMACRO (:DEFAULT-BINARY-FILE-TYPE DEFSYSTEM-MACRO) (TYPE)
  (case type
    ((:qfasl)
     (setq type (first (get compiler:*target-computer* 'si:make-system)))))
  (SETF (system-default-binary-file-type *SYSTEM-BEING-DEFINED*) TYPE)
  (SETQ *SYSTEM-DEFAULT-BINARY-FILE-TYPE* TYPE)
  NIL)

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:38:43
#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.
 :FOR-FALCON - compile for the Falcon
 :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."
			 (let ((sys (find-system-named system t)))
			   (if sys (system-name sys) 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*))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:39:02
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFUN SYSTEM-SOURCE-FILES-1 (SYSTEM TYPES INTERMEDIATE-TOO INCLUDE-SUBSYSTEMS
			      &AUX *SYSTEM-DEFAULT-BINARY-FILE-TYPE*)
  (SETQ SYSTEM (FIND-SYSTEM-NAMED SYSTEM))
  (SETQ *SYSTEM-DEFAULT-BINARY-FILE-TYPE* (system-default-binary-file-type system))
  (NCONC (LET ((SYMBOL (SYSTEM-SYMBOLIC-NAME SYSTEM)))
	   (AND SYMBOL
		(LET ((FILE (GET-SOURCE-FILE-NAME SYMBOL 'DEFSYSTEM)))
		  (AND FILE
		       (LET ((DEFINING-SYSTEM (SEND FILE :GET 'MAYBE-RELOAD-SYSTEM)))
			 (AND DEFINING-SYSTEM
			      (SYSTEM-SOURCE-FILES-1 DEFINING-SYSTEM TYPES INTERMEDIATE-TOO
						     INCLUDE-SUBSYSTEMS)))
		       ))))
	 ;; First get inputs that come from files in modules
	 ;; We get them from transformations, but the order we consider
	 ;; the transformations is the order the modules were specified.
	 (LET ((*FORCE-PACKAGE* (SYSTEM-PACKAGE-DEFAULT SYSTEM)))
	   (LOOP FOR MODULE IN (REVERSE (SYSTEM-MODULES SYSTEM))
		 NCONC (LOOP FOR TRANSFORMATION IN (SYSTEM-TRANSFORMATIONS SYSTEM)
			     WHEN (EQ (TRANSFORMATION-INPUT TRANSFORMATION) MODULE)
			     NCONC (TRANSFORMATION-SOURCE-FILES TRANSFORMATION TYPES NIL))))
	 ;; Now get intermediate source files if wanted.
	 ;; Those are files that are "sources" for some transformations
	 ;; but are produced by others rather than specified in modules.
	 (AND INTERMEDIATE-TOO
	      (LET ((*FORCE-PACKAGE* (SYSTEM-PACKAGE-DEFAULT SYSTEM)))
		(LOOP FOR TRANSFORMATION IN (SYSTEM-TRANSFORMATIONS SYSTEM)
		      WHEN (NOT (TYPEP (TRANSFORMATION-INPUT TRANSFORMATION) 'MODULE))
		      NCONC (TRANSFORMATION-SOURCE-FILES TRANSFORMATION TYPES T))))
	 (AND INCLUDE-SUBSYSTEMS
	      (LOOP FOR SUBSYS IN (SYSTEM-COMPONENT-SYSTEMS SYSTEM)
		    NCONC (SYSTEM-SOURCE-FILES-1 SUBSYS TYPES INTERMEDIATE-TOO
						 INCLUDE-SUBSYSTEMS)))))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:40:06
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFINE-SIMPLE-TRANSFORMATION :FASLOAD FASLOAD-1 FILE-NEWER-THAN-INSTALLED-P
			      (*system-default-binary-file-type* *SYSTEM-load-BINARY-FILE-TYPE*) NIL "load" NIL)

(DEFINE-SIMPLE-TRANSFORMATION :COMPILE QC-FILE-1 FILE-NEWER-THAN-FILE-P
			      (:LISP) (*SYSTEM-DEFAULT-BINARY-FILE-TYPE* *system-load-binary-file-type*))
))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:40:36
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFUN FILE-NEWER-THAN-FILE-P (FILE-1 FILE-2 &optional defs)
  ;; We could look at both of them, but that would slow things down a lot.
  (let ((file-2 (or defs file-2)))
    (IF (PROBEF FILE-2)
	(> (SYSTEM-GET-CREATION-DATE FILE-1)
	   (SYSTEM-GET-CREATION-DATE FILE-2 T))
      T)))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:41:08
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFUN FILE-NEWER-THAN-INSTALLED-P (FILE &optional defs-file &AUX
				    (LOADED-ID (GET-FILE-LOADED-ID FILE *FORCE-PACKAGE*)))
  (AND (NOT *JUST-ACCUMULATING-FILES*)
       MAKSYS-BREAKPOINT-FLAG
       LOADED-ID
       (NOT (EQUAL LOADED-ID (SYSTEM-GET-FILE-INFO (or defs-file FILE))))
       (ERROR "TESTING MAKSYS"))
  (IF LOADED-ID
      (NOT (EQUAL LOADED-ID (SYSTEM-GET-FILE-INFO (or defs-file FILE))))
    T))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:41:38
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFUN FASLOAD-1 (INFILE &optional defs-file)
  (SETQ *SOMETHING-LOADED* T)
  (FASLOAD (or defs-file INFILE) *FORCE-PACKAGE* T))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:41:56
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFUN QC-FILE-1 (INFILE OUTFILE &optional defs-file)
  (multiple-value-bind (*system-default-binary-file-type* *system-load-binary-file-type* compiler-fun)
      (values-list (get compiler:*target-computer* 'make-system))
    (let* ((type *SYSTEM-DEFAULT-BINARY-FILE-TYPE*)
	   (special-compiler (assq type *known-binary-file-producers*)))
      (if special-compiler
	  (funcall (second special-compiler) infile outfile)
	;; This was a MULTIPLE-VALUE-CALL, but the Lambda compiler screws up badly
	;; on that!!! (I think the cross compiler wins though).
	(apply compiler-fun
	  infile
	  :output-file (send outfile :new-version nil)
	  :package *force-package*
	  (if defs-file
	      (list :environment-pathname defs-file)
	    (if (null *system-load-binary-file-type*)
		nil
	      (list :environment-pathname
		    (send (pathname (or outfile infile))
			  :new-type *system-load-binary-file-type*)))))))
    (WHEN *WARNINGS-STREAM*
      (PRINT-FILE-WARNINGS INFILE *WARNINGS-STREAM*)
      (SEND-IF-HANDLES *WARNINGS-STREAM* :FORCE-OUTPUT)
      (SEND-IF-HANDLES *WARNINGS-STREAM* :FINISH))))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:44:09
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

#+(target lambda)
(define-make-system-special-variable compiler:*target-computer* 'compiler:lambda-interface nil)
#+(target falcon)
(define-make-system-special-variable compiler:*target-computer* 'compiler:k nil)

(define-make-system-special-variable *system-load-binary-file-type* nil)

(define-make-system-special-variable compiler:*compilation-environment*
				     (compiler:make-compilation-environment
				       :target (case compiler:*target-computer*
						 (compiler:k 'compiler:falcon)
						 (otherwise compiler:*target-computer*)))
  nil)
))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:44:40
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

;;; For typing convenience; :FOR-FALCON is the official one.
(defun (:for-k make-system-keyword) ()
  (make-system-for-falcon))

(defun make-system-for-falcon ()
  (setq compiler:*target-computer* 'compiler:k)
  (setq *system-default-binary-file-type* :fbin)
  (setq *system-load-binary-file-type* :fdef)
  (setq compiler:*compilation-environment*
	(compiler:make-compilation-environment :target 'compiler:falcon
					       :next compiler:*falcon-environment*)))

(defun (:for-falcon make-system-keyword) ()
  (make-system-for-falcon))
))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:44:59
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFUN ReadForCompilation? (Name &AUX (Source (FUNCALL Name ':NEW-TYPE "LISP"))
			    (Binary (FUNCALL Name ':NEW-TYPE
					     (or *SYSTEM-load-BINARY-FILE-TYPE*
						 *SYSTEM-default-BINARY-FILE-TYPE*))))
  (COND ((FILE-NEWER-THAN-FILE-P Source Binary)
	 (FILE-NEWER-THAN-INSTALLED-P Source))
	(T (FILE-NEWER-THAN-INSTALLED-P Binary))))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:46:03
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFUN GET-TRANSFORMATION-PATHNAMES (TRANSFORMATION &AUX PATHNAME-LIST)
  (IF (SETQ PATHNAME-LIST (CDR (ASSQ TRANSFORMATION *TRANSFORMATION-OUTPUTS*)))
      (VALUES PATHNAME-LIST T)
      (LET ((INPUT (TRANSFORMATION-INPUT TRANSFORMATION)))
	(SELECTQ (TYPE-OF INPUT)
	  (MODULE
	   (SETQ PATHNAME-LIST (GET-MODULE-PATHNAMES INPUT)))
	  (TRANSFORMATION
	   (SETQ PATHNAME-LIST (GET-TRANSFORMATION-PATHNAMES INPUT)))
	  (OTHERWISE
	   (FERROR NIL "~S is not a valid transformation input" INPUT))))
      (LOOP FOR PATHNAME IN PATHNAME-LIST
	    WITH TRANSFORMATION-TYPE = (TRANSFORMATION-TRANSFORMATION-TYPE TRANSFORMATION)
	    AS PKG = (POP PATHNAME)
	    ;;Take off as many inputs as would be used
	    DO (DO L (TRANSFORMATION-TYPE-INPUT-FILE-TYPES TRANSFORMATION-TYPE)
		   (CDR L) (NULL L)
		 (POP-CAREFULLY PATHNAME))
	    ;;Now accumulate output types
	    AS OUTPUTS = (LOOP FOR FILE-TYPE IN (TRANSFORMATION-TYPE-OUTPUT-FILE-TYPES
						  TRANSFORMATION-TYPE)
			       for fte = (eval file-type)
			       COLLECT (when fte
					 (MERGE-PATHNAME-TYPE (POP-CAREFULLY PATHNAME) fte)))
	    COLLECT (CONS PKG (NCONC OUTPUTS PATHNAME)))))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:46:21
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

(DEFUN ADD-FILE-TRANSFORMATION (TRANSFORMATION PATHNAMES
				&AUX TRANSFORMATION-TYPE CONDITION-FUNCTION
				     INPUT-XFORM PKG INPUTS OUTPUTS ARGS FILE-TRANSFORMATION
				     SYSTEM)
  (SETQ TRANSFORMATION-TYPE (TRANSFORMATION-TRANSFORMATION-TYPE TRANSFORMATION)
	CONDITION-FUNCTION (TRANSFORMATION-CONDITION-FUNCTION TRANSFORMATION)
	SYSTEM (TRANSFORMATION-SYSTEM TRANSFORMATION))
  (SETQ PKG (POP PATHNAMES))
  (AND (LISTP PKG) (SETQ INPUT-XFORM PKG
			 PKG (FILE-TRANSFORMATION-FORCE-PACKAGE PKG)))
  (SETQ INPUTS (LOOP FOR FILE-TYPE IN (TRANSFORMATION-TYPE-INPUT-FILE-TYPES
				         TRANSFORMATION-TYPE)
		     for fte = (EVAL FILE-TYPE)
		     COLLECT (when fte
			       (MERGE-PATHNAME-TYPE (POP-CAREFULLY PATHNAMES) fte)))
	OUTPUTS (LOOP FOR FILE-TYPE IN (TRANSFORMATION-TYPE-OUTPUT-FILE-TYPES
					  TRANSFORMATION-TYPE)
		      for fte = (EVAL FILE-TYPE)
		      COLLECT (when fte
				(MERGE-PATHNAME-TYPE (POP-CAREFULLY PATHNAMES)
						     fte)))
	ARGS (NCONC INPUTS OUTPUTS))
  (COND ((SETQ FILE-TRANSFORMATION (DOLIST (FILE-XFORM *FILE-TRANSFORMATION-LIST*)
				     (AND (EQ (FILE-TRANSFORMATION-TRANSFORMATION-TYPE
						FILE-XFORM)
					      TRANSFORMATION-TYPE)
					  (EQUAL (FILE-TRANSFORMATION-ARGS FILE-XFORM) ARGS)
					  (EQ (FILE-TRANSFORMATION-FORCE-PACKAGE FILE-XFORM)
					      PKG)
					  (EQ (FILE-TRANSFORMATION-SYSTEM FILE-XFORM)
					      SYSTEM)
					  (RETURN FILE-XFORM))))
	 ;;Found, extend the condition
	 (SETF (FILE-TRANSFORMATION-CONDITION-FUNCTION FILE-TRANSFORMATION)
	       (LET ((OLD-CONDITION-FUNCTION (FILE-TRANSFORMATION-CONDITION-FUNCTION
					       FILE-TRANSFORMATION)))
		 (COND ((EQ OLD-CONDITION-FUNCTION CONDITION-FUNCTION)
			CONDITION-FUNCTION)	;The same
		       ((CLOSUREP OLD-CONDITION-FUNCTION)
			(PUSH* CONDITION-FUNCTION
			       (SYMEVAL-IN-CLOSURE OLD-CONDITION-FUNCTION
						   '*CONDITION-FUNCTIONS*)))
		       (T
			(LET-CLOSED ((*CONDITION-FUNCTIONS* (LIST OLD-CONDITION-FUNCTION
								  CONDITION-FUNCTION)))
			  'MULTIPLE-FILE-CONDITION)))))		     
	 (SETQ *FILE-TRANSFORMATION-LIST*
	       (DELQ FILE-TRANSFORMATION *FILE-TRANSFORMATION-LIST*)))
	(T
	 (SETQ FILE-TRANSFORMATION (MAKE-FILE-TRANSFORMATION TRANSFORMATION-TYPE
							       TRANSFORMATION-TYPE
							     FORCE-PACKAGE PKG
							     SYSTEM SYSTEM
							     CONDITION-FUNCTION
							       CONDITION-FUNCTION
							     OUTPUTS OUTPUTS
							     ARGS ARGS))))
  (PUSH FILE-TRANSFORMATION *ADDED-FILE-TRANSFORMATIONS*)
  (LET ((OUTPUT (CONS FILE-TRANSFORMATION (APPEND OUTPUTS PATHNAMES)))
	(ELEM (ASSQ TRANSFORMATION *TRANSFORMATION-OUTPUTS*)))
    (IF ELEM (NCONC ELEM (NCONS OUTPUT))
	(PUSH (LIST TRANSFORMATION OUTPUT) *TRANSFORMATION-OUTPUTS*)))
  (CONS INPUT-XFORM FILE-TRANSFORMATION))

))

; From modified file DJ: L.SYS2; MAKSYS.LISP#211 at 11-Aug-88 01:45:24
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  "

;;; Patch-file only
(defun fixup-existing-systems ()
  (loop for sys in *systems-list*
	do
	(typecase sys
	  (system
	   (loop for trans in (system-transformations sys)
		 for type = (transformation-transformation-type trans)
		 for ntype = (assoc (car type) *transformation-type-alist*)
		 do
		 (if (not ntype)
		     (cerror "Do the rest of the transformations."
			     "Missing transformation type: ~S." (car type))
		   (setf (transformation-transformation-type trans) ntype)))))))

(fixup-existing-systems)
))