(FILECREATED " 8-Nov-84 19:20:55" {DSK}<PLH>COMPILEBANG.;1 2500   

      changes to:  (LISPXMACROS C)
		   (FNS COMPILE!)

      previous date: "10-MAR-83 12:48:17" {ERIS}<LISP>HARMONY>LIBRARY>COMPILEBANG.;1)


(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT COMPILEBANGCOMS)

(RPAQQ COMPILEBANGCOMS ((E (RESETSAVE CLISPIFYPRETTYFLG NIL))
			(LISPXMACROS C)
			(FNS COMPILE!)
			(USERMACROS C)))

(ADDTOVAR LISPXMACROS (C (COND (LISPXLINE (COMPILE! (CAR LISPXLINE)
						    NIL NIL T))
			       (T C))))
(DEFINEQ

(COMPILE!
  [LAMBDA (X NOSAVE NOREDEFINE PRINTLAP)                                (* bvm: "10-MAR-83 12:48")
    (DECLARE (SPECVARS LCFIL LAPFLG STRF SVFLG LSTFIL SPECVARS LOCALVARS))

          (* In-core compiling for functions and forms, without the interview. If X is a list, we assume that we are being 
	  called merely to display the lap and machine code. THe form is compiled as the definition of FOO but the compiled 
	  code is thrown away. -
	  If X is a litatom, then saving, redefining, and printing is controlled by the flags.)


    (DECLARE (GLOBALVARS NLAMA NLAML LAMS LAMA NOFIXFNSLST NOFIXVARSLST))
    (RESETVARS ((NLAMA NLAMA)
		(NLAML NLAML)
		(LAMS LAMS)
		(LAMA LAMA)
		(NOFIXFNSLST NOFIXFNSLST)
		(NOFIXVARSLST NOFIXVARSLST))
	       (RETURN (RESETLST                                        (* RESETLST to provide reset context for 
									macros under COMPILE1 as generated e.g. by 
									DECL.)
				 (PROG [(LCFIL)
					[LAPFLG (AND PRINTLAP (COND
						       (BYTECOMPFLG T)
						       (T 2]
					(STRF (NOT NOREDEFINE))
					(SVFLG (NOT NOSAVE))
					(LSTFIL T)
					(SPECVARS T)
					(LOCALVARS (COND
						     ((NEQ LOCALVARS T)
						       (UNION SYSLOCALVARS LOCALVARS))
						     (T SYSLOCALVARS]
				       (RETURN (COMPILE1 (COND
							   ((LITATOM X)
							     X)
							   (T '*DUMMY-COMPILED-FUNCTION*))
							 (COND
							   ((NLISTP X)
							     (VIRGINFN X T))
							   ((ARGTYPE X)
							     X)
							   (T (LIST 'LAMBDA NIL X)))
							 T])
)

(ADDTOVAR USERMACROS [C NIL (ORR (UP 1)
				 NIL)
			(ORR ((E (COMPILE! (OR (LISTP (%#%#))
					       (%#%# !0))
					   T T T)))
			     ((E 'C?])

(ADDTOVAR EDITCOMSA C)
(PUTPROPS COMPILEBANG COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (568 2226 (COMPILE! 578 . 2224)))))
STOP