;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.26
;;; Reason:
;;;  Minor bug in COMPILE-FILE-FOR-FALCON
;;; Written 9-Aug-88 20:31:33 by smh (Steve Haflich) at site Gigamos Cambridge
;;; while running on Harpo from band 3
;;; with Experimental System 126.23, ZWEI 125.14, 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 file DJ: L.SYS; QCFILE.LISP#374 at 9-Aug-88 20:31:41
#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-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-p
					explicit-compilation-environment
				      *falcon-environment*))
	 (env (if explicit-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
					    (send (or output-file file) :new-type :fdef))
					  :byte-size 8.
					  :dont-set-default-p (NOT SET-DEFAULT-PATHNAME))))))
    (AND RESULT LOAD (LOAD RESULT :SET-DEFAULT-PATHNAME NIL))
    RESULT))

))