;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 121.21
;;; Reason:
;;;  Hacked compiler to handle lexical closures created by the new evaluator.
;;; Written 2-Feb-87 10:36:33 by rauen at site LMI Cambridge
;;; while running on Poindexter from band 3
;;; with Experimental System 121.20, 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 1730, SDU Boot Tape 3.14, SDU ROM 103.



; From modified file DJ: L.SYS; QCP1.LISP#677 at 2-Feb-87 10:36:47
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCP1  "

(DEFUN COMPILE (NAME &OPTIONAL LAMBDA-EXP (PROCESSING-MODE 'MACRO-COMPILE))
  "Compile the definition of NAME,
or its previous interpreted definition if it is already compiled.
If LAMBDA-EXP is supplied, it is compiled and made the definition of NAME.
If NAME is NIL, LAMBDA-EXP is compiled and the result is just returned."
; Temporary areas are no more.
; (AND QC-FILE-IN-PROGRESS	;Check for condition likely to cause temporary area lossage
;      (FORMAT *ERROR-OUTPUT* "~&COMPILE: Compiler entered recursively; you may lose.~%"))
  (IF (NULL NAME)
      (COMPILE-LAMBDA LAMBDA-EXP (GENSYM))
    (LOCKING-RESOURCES-NO-QFASL
      (FILE-OPERATION-WITH-WARNINGS (T ':COMPILE)
	(COMPILER-WARNINGS-CONTEXT-BIND
	  (LET (TEM FILE-SPECIAL-LIST FILE-UNSPECIAL-LIST FILE-LOCAL-DECLARATIONS)
	    (QC-PROCESS-INITIALIZE)
	    (OR LAMBDA-EXP
		(AND (FDEFINEDP NAME)
		     (SETQ TEM (FDEFINITION (SI:UNENCAPSULATE-FUNCTION-SPEC NAME)))
		     (TYPECASE TEM
		       (CONS (SETQ LAMBDA-EXP TEM))
		       (CLOSURE 
			(IF (AND (FIND-PACKAGE "INTERPRETER")
				 (BOUNDP-IN-CLOSURE TEM
				   (INTERN "INTERPRETER-CLOSURE" "INTERPRETER"))
				 (SYMEVAL-IN-CLOSURE TEM
				   (INTERN "INTERPRETER-CLOSURE" "INTERPRETER")))
			    (SETQ LAMBDA-EXP 
				  (SYMEVAL-IN-CLOSURE TEM 
				    (INTERN "ORIGINAL-DEFINITION" "INTERPRETER")))
			  (FERROR "Compilation of closures not yet hacked.")))
		       (COMPILED-FUNCTION
			(SETQ TEM (ASSQ 'INTERPRETED-DEFINITION
					(DEBUGGING-INFO TEM)))
			(SETQ LAMBDA-EXP (CADR TEM)))
		       (T
			NIL)))
		(FERROR "Can't find LAMBDA expression for ~S" NAME))
	    (LET ((INHIBIT-FDEFINE-WARNINGS T))
	      (COMPILE-1 NAME LAMBDA-EXP PROCESSING-MODE))
	    NAME))))))
))