;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.118
;;; Reason:
;;;  Make compile-file-for-falcon bind the variable
;;;  eh:*bug-report-recipient-system*
;;; Reason:
;;;  make COMPILE-DEFUN-INTERNAL and COMPILE-FILE-FOR-FALCON use the
;;;  eh:*bug-report-recipient-system* variable.
;;; Reason:
;;;  Make COMPILE-DEFUN-INTERNAL and COMPILE-FILE-FOR-FALCON use
;;;  the new eh:*bug-report-recipient-system* variable.
;;; Written 19-Oct-88 17:08:56 by JIM at site Gigamos Cambridge
;;; while running on Maurice Ravel from band 3
;;; with Experimental System 126.117, Experimental ZWEI 126.21, Experimental ZMail 74.10, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Unix-Interface 15.0, Experimental Tape 26.4, Experimental Lambda-Diag 18.0, Microcode 1762, SDU Boot Tape 3.14, SDU ROM 102, Kenv 10/4.



; From modified file DJ: L.SYS; QCFILE.LISP#383 at 19-Oct-88 17:08:59
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCFILE  "

(DEFUN COMPILE-FILE-for-falcon (INPUT-FILE &KEY
				OUTPUT-FILE
				(SET-DEFAULT-PATHNAME T)
				LOAD
				((:PACKAGE PACKAGE-SPEC))
				(explicit-compilation-environment nil explicit-c-e-p)
				(environment-pathname nil env-supplied-p))
  "Compile file INPUT-FILE to a QFASL file named OUTPUT-FILE.
OUTPUT-FILE defaults based on INPUT-FILE, which defaults using the standard defaults.
SET-DEFAULT-PATHNAME if NIL means do not set the defaults.
PACKAGE if non-NIL is the package to compile in.
LOAD means to load the file after compiling it."
  (LET* ((*compilation-environment* (if explicit-c-e-p
					explicit-compilation-environment
				      *falcon-environment*))
	 (eh:*bug-report-recipient-system* "FALCON-COMPILER")
	 (env (if explicit-c-e-p
		  *compilation-environment*
		(make-compilation-environment :target 'falcon)))
	 (FILE (FS:MERGE-PATHNAME-DEFAULTS (OR INPUT-FILE "") *DEFAULT-PATHNAME-DEFAULTS*))
	 (RESULT (CATCH-ERROR-RESTART (EH:DEBUGGER-CONDITION "Give up on compiling ~A." FILE)
		   (ERROR-RESTART (EH:DEBUGGER-CONDITION "Retry compiling ~A." FILE)
		     (compile-file-driver file
					  :output-file output-file
					  :package-spec package-spec
					  :explicit-compilation-environment env
					  :target-computer 'k
					  :target-features si:*falcon-features*
					  :environment-pathname
					  (if env-supplied-p
					      environment-pathname
					    (let ((pathname-source (if output-file	;not exactly right
								       (FS:MERGE-PATHNAME-DEFAULTS output-file file)
								     file)))
					      (send pathname-source :new-pathname
						    :type :fdef
						    :version (IF *QC-FILE-OUTPUT-SAME-VERSION*
								 (SEND (SEND pathname-source :TRUENAME) :VERSION)
							       :NEWEST))))
					  :byte-size 8.
					  :dont-set-default-p (NOT SET-DEFAULT-PATHNAME))))))
    (AND RESULT LOAD (LOAD RESULT :SET-DEFAULT-PATHNAME NIL))
    RESULT))

))