(FILECREATED "27-Sep-84 23:09:44" {ERIS}<LISPCORE>SOURCES>LLFCOMPILE.;2
 21645  

      changes to:  (VARS LLFCOMPILECOMS)

      previous date: "13-FEB-83 16:38:35" {ERIS}<LISPCORE>SOURCES>LLFCOMPILE.;1)


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

(PRETTYCOMPRINT LLFCOMPILECOMS)

(RPAQQ LLFCOMPILECOMS
 ((DECLARE: FIRST (VARS (COMPILEATPUTDFLG)))
	(VARS (\FCCODESIZE 750))
	(FNS COMPST0 FCOMPILERR GROWFCCODE OP# \ARGCHECK \ARGCHECKFAIL \MAKEPSEUDOCODE 
	     \PSEUDOCODE.REALDEF)
	(FNS FCOMPILE FCOMPILE2 COMP0 COMP0DEF CEXP0 CEXPA0 CATOM0 CCON0 CFIXCON0 CPROG0 CGO0 
	     CRETURN0 CPROG10 CPROGN0 CLAM0 CSELQ0 CCALL0 CERSET0 CCALL2 CLAM01 CADJUST0 CCALL1 
	     CCOND0 CJUMPX JFIX0 CBYTE0)
	(VARS (\FCCODEARRAY (\CODEARRAY \FCCODESIZE 0)))
	(DECLARE: EVAL@COMPILE DONTCOPY
		  (ADDVARS (NOFIXVARSLST GVAR_ PVAR_ PVARX_ IVARX_ FVARX_ 'NIL 'T '0 '1 PVAR_^))
		  (GLOBALVARS \FCCODESIZE \FCCODEARRAY))
	(MACROS OP#)
	(TEMPLATES OP#)
	(PROP FCOMPILE CADR CAR CDR IPLUS IDIFFERENCE SUB1 EQ LISTP NEQ NLISTP NULL NOT \GETBASEPTR 
	      ILESSP IGREATERP)
	(P (MOVD? (QUOTE NILL)
		  (QUOTE ADDREF)))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA OP#)
									      (NLAML)
									      (LAMA)))))
(DECLARE: FIRST 

(RPAQQ COMPILEATPUTDFLG
 NIL)
)

(RPAQQ \FCCODESIZE
 750)
(DEFINEQ

(COMPST0

  [LAMBDA (CODE IVARS PVARS FVARS AT START COMFN)
                                   (* lmm "13-FEB-83 15:44")

    (SETQ CODE (CBYTE0
 (OP#
 -X-)
		       CODE))
    (PROG (NTSIZE REALSIZE STARTPC NTWORDS CA FVAROFFSET LOCALARGS STARTLOCALS LOCALSIZE
		  (IVARCNT (LENGTH IVARS))
		  (PVARCNT (LENGTH PVARS))
		  FVARCNT FVARS)
          (SETQ FVARCNT PVARCNT)
          (for
 X in
 FVARREF
	     do
 [OR (SETQ D (FASSOC (CAR X)
				    FVARS))
		    (push
 FVARS (SETQ D (CONS (CAR X)
					      (PROG1 FVARCNT (add
 FVARCNT 1]
		(CODESETA \FCCODEARRAY (CADR X)
			  (LLSH (CDR D)
				1)))
          (SETQ NTWORDS (LLSH (SETQ NTSIZE (CEIL (IPLUS IVARCNT FVARCNT 1)
						 WORDSPERQUAD))
			      1))
          (SETQ STARTPC (UNFOLD (IPLUS (fetch
 (CODEARRAY OVERHEADWORDS) of
 T)
				       NTWORDS)
				BYTESPERWORD))
                                   (* initial pc for the function: after fixed header and double nametable)

          (SETQ REALSIZE (CEIL (IPLUS STARTPC CODE)
			       BYTESPERQUAD))
          (SETQ CA (\CODEARRAY REALSIZE (CEIL (ADD1 (FOLDHI STARTPC BYTESPERCELL))
					      CELLSPERQUAD)))
          (PROG ((NT1 (ADD1 (UNFOLD (fetch
 (CODEARRAY OVERHEADWORDS) of
 T)
				    BYTESPERWORD)))
		 (NTBSZ (UNFOLD NTSIZE BYTESPERWORD)))
	        (for
 X in
 PVARS
		   do
 (\FIXCODENUM CA NT1 (\ATOMVALINDEX (CAR X)))
		      (\FIXCODENUM CA (IPLUS NT1 NTBSZ)
				   (IPLUS PVARCODE (CDR X)))
		      (add
 NT1 BYTESPERWORD))
	        (for
 X in
 IVARS
		   do
 (\FIXCODENUM CA NT1 (\ATOMVALINDEX (CAR X)))
		      (\FIXCODENUM CA (IPLUS NT1 NTBSZ)
				   (IPLUS IVARCODE (CDR X)))
		      (add
 NT1 BYTESPERWORD))
	        (SETQ FVAROFFSET (FOLDLO NT1 BYTESPERWORD))
	        (for
 X in
 (REVERSE FVARS)
		   do
 (\FIXCODENUM CA NT1 (\ATOMVALINDEX (CAR X)))
		      (\FIXCODENUM CA (IPLUS NT1 NTBSZ)
				   (IPLUS FVARCODE (CDR X)))
		      (add
 NT1 BYTESPERWORD)))
          (PROGN                   (* Fill in function header)

		 (replace
 (CODEARRAY NA) of
 CA with
 (COND
						      ((EQ AT 2)
							-1)
						      (T IVARCNT)))
		 (replace
 (CODEARRAY PV) of
 CA with
 (SUB1 (FOLDHI FVARCNT CELLSPERQUAD)))
		 (replace
 (CODEARRAY STARTPC) of
 CA with
 STARTPC)
		 (replace
 (CODEARRAY ARGTYPE) of
 CA with
 AT)
		 (replace
 (CODEARRAY FRAMENAME) of
 CA with
 COMFN)
		 (replace
 (CODEARRAY NTSIZE) of
 CA with
 NTSIZE)
		 (replace
 (CODEARRAY NLOCALS) of
 CA with
 PVARCNT)
		 (replace
 (CODEARRAY FVAROFFSET) of
 CA with
 FVAROFFSET)
		 (replace
 (CODEARRAY FIXED) of
 CA with
 T))
          (while
 (ILESSP START CODE)
	     do
 (CODESETA CA STARTPC (CODELT \FCCODEARRAY START))
		(add
 START 1)
		(add
 STARTPC 1))
          (RETURN CA])

(FCOMPILERR

  [LAMBDA (X Y)                    (* lmm "18-FEB-82 22:19")

    (printout
 T X Y T)
    (RETFROM RETLOC])

(GROWFCCODE

  [LAMBDA (GROWTH)                                           (* lmm "17-FEB-82 15:39")

    (PROG ((CA (\CODEARRAY (SETQ GROWTH (IPLUS \FCCODESIZE GROWTH))
			   0)))
          (for
 J from
 0 while
 (ILESSP J \FCCODESIZE) do
 (CODESETA CA J (CODELT \FCCODEARRAY J)))
          (SETQ \FCCODEARRAY CA)
          (SETQ \FCCODESIZE GROWTH])

(OP#

  [NLAMBDA X                       (* lmm "12-FEB-82 23:50")

    (CAR (\FINDOP (CAR X])

(\ARGCHECK

  [LAMBDA (X TYP ARGS)                                       (* edited: "19-FEB-82 15:57")


          (* could do in line with (X COPY CAR (QUOTE TYP) EQ TJUMP+2 FAIL CDR COPY LISTP TJUMP+2 FAIL CAR 

	  (QUOTE ARGS) EQUAL TJUMP+2 FAIL))



    (COND
      ((OR (NEQ (CAR X)
		TYP)
	   (NLISTP (CDR X))
	   (NOT (EQUAL (CADR X)
		       ARGS)))
	(\ARGCHECKFAIL
 X])

(\ARGCHECKFAIL

  [LAMBDA (LAM)                                              (* edited: "19-FEB-82 16:35")

    (PROG ((FN (STKNAME -3)))
          (PUTD FN (GETD FN))
          (LISPERROR "ILLEGAL ARG" LAM])

(\MAKEPSEUDOCODE

  [LAMBDA (LAM TOPFN)                                        (* edited: "19-FEB-82 16:25")

    (AND COMPILEATPUTDFLG (DEFINEDP (QUOTE COMP0DEF))
	 (PROG ((RETLOC (QUOTE \MAKEPSEUDOCODE)))
	       (RETURN (AND (LISTP LAM)
			    (LISTP (CDR LAM))
			    (SELECTQ (CAR LAM)
				     ([LAMBDA NLAMBDA]
				       (fetch
 (ARRAYP BASE)
					  of
 (COMP0DEF
 TOPFN
						       [LIST (CAR LAM)
							     (CADR LAM)
							     [LIST (QUOTE \ARGCHECK)
								   (KWOTE LAM)
								   (KWOTE (CAR LAM))
								   (KWOTE (COND
									    ((LISTP (CADR LAM))
									      (APPEND (CADR LAM)))
									    (T (CADR LAM]
							     (SELECTQ COMPILEATPUTDFLG
								      (ALL (CONS (QUOTE PROGN)
										 (CDDR LAM)))
								      (LIST (QUOTE \EVPROGN)
									    (KWOTE (CDDR LAM]
						       0)))
				     NIL])

(\PSEUDOCODE.REALDEF

  [LAMBDA (FNH)                                              (* edited: "19-FEB-82 16:24")

    (AND FNH (\GETBASEPTR FNH (FOLDLO (fetch
 (FNHEADER STARTPC) of
 FNH)
				      BYTESPERWORD])
)
(DEFINEQ

(FCOMPILE

  [LAMBDA (FNLST)                                            (* lmm "17-FEB-82 11:47")


          (* Note that the "mini-compiler" is machine dependent in two ways: it knows the all the opcodes and it uses 

	  knowledge about the representation of code arrays in COMPST0 and CBYTE0)



    (PROG (EFF RETF PREDF)
          (DECLARE
 (SPECVARS EFF RETF PREDF))
          (RETURN (for
 X inside
 FNLST bind
 DEF collect
 (OR (AND (LITATOM X)
								(EXPRP (SETQ DEF (VIRGINFN X T)))
								(FCOMPILE2
 X DEF))
							   (CONS X (QUOTE (not compilable])

(FCOMPILE2

  [LAMBDA (TOPFN DEF)              (* lmm "18-FEB-82 22:18")

    (PROG ((RETLOC (QUOTE FCOMPILE2)))
          (RETURN (COMP0
 TOPFN DEF 0])

(COMP0

  [LAMBDA (COMFN DEF START)        (* lmm "18-FEB-82 22:13")

    (DPUTCODE COMFN (COMP0DEF
 COMFN DEF START))
    COMFN])

(COMP0DEF

  [LAMBDA (COMFN DEF START)        (* lmm "18-FEB-82 22:18")

    (PROG (IVARS PVARS FVARS (LBL NIL)
		 (INPROG NIL)
		 (IVARN 0)
		 (VL (CADR DEF))
		 (AT (ARGTYPE DEF))
		 (PVARN 0)
		 CURRENTPVARS
		 (FVARREF))
          (SETQ DEF (CDDR DEF))
          [OR (LISTP VL)
	      (NULL VL)
	      (COND
		((NEQ AT 2)        (* NLAMBDA*)

		  (SETQ VL (LIST VL)))
		(T [OR (EQ VL (QUOTE NOBIND))
		       (SETQ DEF (LIST (LIST (CONS (QUOTE LAMBDA)
						   (CONS (LIST VL)
							 DEF))
					     (QUOTE (\MYARGCOUNT]
		   (SETQ VL]
          [MAPC VL (FUNCTION (LAMBDA (V)
		    (push
 IVARS (CONS V (PROG1 IVARN (add
 IVARN 1]
          (RETURN (COMPST0
 (CBYTE0
 (OP#
 RETURN)
				   (CPROGN0
 DEF START))
			   IVARS PVARS FVARREF AT START COMFN])

(CEXP0

  [LAMBDA (E CODE)                 (* lmm "12-FEB-82 23:11")

    (COND
      ((LISTP E)
	(CCALL0
 E CODE))
      (T (CATOM0
 E CODE])

(CEXPA0

  [LAMBDA (ARGCNT E CODE)          (* lmm "13-FEB-82 14:15")

    (COND
      ((LISTP E)
	(CCALL0
 E CODE))
      (T (CATOM0
 E CODE])

(CATOM0

  [LAMBDA (VAR CODE SET)                                     (* lmm "17-FEB-82 12:31")

    (PROG (D)
          (RETURN (COND
		    [(SETQ D (CDR (FASSOC VAR IVARS)))
		      (COND
			(SET (CBYTE0
 (LLSH D 1)
				     (CBYTE0
 (OP#
 IVARX_)
					     CODE)))
			((IGEQ D 7)
			  (CBYTE0
 (LLSH D 1)
				  (CBYTE0
 (OP#
 IVARX)
					  CODE)))
			(T (CBYTE0
 (IPLUS (OP#
 IVAR)
					  D)
				   CODE]
		    [(SETQ D (CDR (FASSOC VAR CURRENTPVARS)))
		      (COND
			(SET (CBYTE0
 (LLSH D 1)
				     (CBYTE0
 (OP#
 PVARX_)
					     CODE)))
			((IGEQ D 7)
			  (CBYTE0
 (LLSH D 1)
				  (CBYTE0
 (OP#
 PVARX)
					  CODE)))
			(T (CBYTE0
 (IPLUS (OP#
 PVAR)
					  D)
				   CODE]
		    ((EQ VAR T)
		      (CBYTE0
 (OP#
 'T)
			      CODE))
		    ((NULL VAR)
		      (CBYTE0
 (OP#
 'NIL)
			      CODE))
		    ((LITATOM VAR)
		      [push
 FVARREF (LIST VAR (SETQ CODE (CBYTE0
 (COND
								   (SET (OP#
 FVARX_))
								   (T (OP#
 FVARX)))
								 CODE]
		      (CBYTE0
 0 CODE))
		    (T (CCON0
 VAR CODE])

(CCON0

  [LAMBDA (X CODE)                 (* lmm "13-FEB-83 15:53")

    (SELECTQ X
	     (NIL (CBYTE0
 (OP#
 'NIL)
			  CODE))
	     (T (CBYTE0
 (OP#
 'T)
			CODE))
	     (0 (CBYTE0
 (OP#
 '0)
			CODE))
	     (1 (CBYTE0
 (OP#
 '1)
			CODE))
	     (COND
	       [(LITATOM X)
		 (PROG ((D (\ATOMPNAMEINDEX X)))
		       (RETURN (CBYTE0
 (LOGAND D 377Q)
				       (CBYTE0
 (LRSH D 10Q)
					       (CBYTE0
 (OP#
 ACONST)
						       CODE]
	       [(AND (NUMBERP X)
		     (IGREATERP X -400Q)
		     (ILEQ X 177777Q))
		 (COND
		   ((IGREATERP 0 X)
		     (CBYTE0
 (IPLUS 400Q X)
			     (CBYTE0
 (OP#
 SNIC)
				     CODE)))
		   ((ILEQ X 377Q)
		     (CBYTE0
 X (CBYTE0
 (OP#
 SIC)
				       CODE)))
		   (T (CBYTE0
 (LOGAND X 377Q)
			      (CBYTE0
 (LRSH X 10Q)
				      (CBYTE0
 (OP#
 SICX)
					      CODE]
	       (T (CFIXCON0
 X (CBYTE0
 0 (CBYTE0
 0 (CBYTE0
 0 (CBYTE0
 (OP#
 GCONST)
								    CODE])

(CFIXCON0

  [LAMBDA (CON LOC CODE)                                     (* lmm "17-FEB-82 13:33")

    (\FIXCODEPTR \FCCODEARRAY (SUB1 LOC)
		 CON)
    LOC])

(CPROG0

  [LAMBDA (VARS BODY CODE)         (* lmm " 3-FEB-80 22:23")

    (COND
      (VARS (CEXP0
 [CONS (LIST (QUOTE LAMBDA)
			       [MAPCAR VARS (FUNCTION (LAMBDA (X)
					   (COND
					     ((LISTP X)
					       (CAR X))
					     (T X]
			       (CONS (QUOTE PROG)
				     (CONS NIL BODY)))
			 (MAPCAR VARS (FUNCTION (LAMBDA (X)
				     (COND
				       ((LISTP X)
					 (CADR X]
		   CODE))
      (T (PROG ([LBL (MAPCONC BODY (FUNCTION (LAMBDA (X)
				  (COND
				    ((LITATOM X)
				      (LIST (LIST X NIL]
		(INPROG T)
		(ARGCNT NIL)
		RRL)
	       [SETQ CODE (CBYTE0
 0 (CBYTE0
 0 (CBYTE0
 (OP#
 BIND)
						      CODE]
	       [MAPC BODY (FUNCTION (LAMBDA (X)
			 (SETQ CODE (COND
			     ((LITATOM X)
			       (RPLACA (CDR (FASSOC X LBL))
				       CODE)
			       CODE)
			     (T (CBYTE0
 (OP#
 POP)
					(CEXP0
 X CODE]
	       [MAPC LBL (FUNCTION (LAMBDA (R)
			 (JFIX0
 (CDDR R)
				(CADR R]
	       (RETURN (CBYTE0
 (OP#
 UNBIND)
			       (JFIX0
 RRL (CBYTE0
 (OP#
 'NIL)
						  CODE])

(CGO0

  [LAMBDA (A CODE)                                           (* lmm "17-FEB-82 15:41")

    (PROG ((D (FASSOC A LBL)))
          [COND
	    ((OR (NULL D)
		 ARGCNT)
	      (FCOMPILERR
 A (QUOTE "- can't handle GO"]
          [SETQ CODE (CBYTE0
 0 (CBYTE0
 0 (CBYTE0
 (OP#
 JUMPXX)
						 CODE]
          (NCONC1 D CODE)
          (RETURN CODE])

(CRETURN0

  [LAMBDA (L CODE)                                           (* lmm "17-FEB-82 11:49")

    (OR INPROG (FCOMPILERR
 L (QUOTE "- illegal RETURN")))
    [SETQ CODE (CBYTE0
 0 (CBYTE0
 0 (CBYTE0
 (OP#
 JUMPXX)
					   (CPROG10
 L CODE]
    (SETQ RRL (CONS CODE RRL))
    CODE])

(CPROG10

  [LAMBDA (L CODE)                 (* lmm "13-FEB-82 14:17")

    (SETQ CODE (CEXP0
 (CAR L)
		      CODE))
    [MAPC (CDR L)
	  (FUNCTION (LAMBDA (X)
	      (SETQ CODE (CBYTE0
 (OP#
 POP)
				 (CEXPA0
 1 X CODE]
    CODE])

(CPROGN0

  [LAMBDA (L CODE)                 (* lmm " 3-FEB-80 21:46")

    (PROG NIL
      LP  (COND
	    ((CDR L)
	      [COND
		((NEQ (CAR (LISTP (CAR L)))
		      (QUOTE *))
		  (SETQ CODE (CBYTE0
 (OP#
 POP)
				     (CEXP0
 (CAR L)
					    CODE]
	      (SETQ L (CDR L))
	      (GO LP)))
          (RETURN (CEXP0
 (CAR L)
			 CODE])

(CLAM0

  [LAMBDA (DEF CODE)               (* lpd "18-APR-77 13:15")

    (COMP0
 (PACK (LIST COMFN (GENSYM)))
	   DEF CODE])

(CSELQ0

  [LAMBDA (X CL CODE)              (* lmm " 3-FEB-80 21:59")

    [COND
      ((NOT (LITATOM X))
	(SETQ CODE (CBYTE0
 (OP#
 POP)
			   (CEXP0
 (LIST (QUOTE SETQ)
					(QUOTE \SELECTQVALUE)
					X)
				  CODE)))
	(SETQ X (QUOTE \SELECTQVALUE]
    (CCOND0
 [MAPLIST CL (FUNCTION (LAMBDA (Y)
			 (COND
			   ((CDR Y)
			     (CONS (LIST (COND
					   ((NLISTP (CAAR Y))
					     (QUOTE EQ
))
					   (T (QUOTE FMEMB
)))
					 X
					 (KWOTE (CAAR Y)))
				   (CDAR Y)))
			   (T (LIST T (CAR Y]
	    CODE])

(CCALL0

  [LAMBDA (FORM CODE)              (* lmm "18-FEB-82 22:10")

    (PROG ((ARGS (CDR FORM))
	   (FN (CAR FORM)))
          (RETURN
	    (SELECTQ
	      (ARGTYPE FN)
	      (0 (SELECTQ FN
			  (RETURN (CRETURN0
 ARGS CODE))
			  (CCALL1
 FN ARGS CODE)))
	      [3 (SELECTQ FN
			  (SETQ (CATOM0
 (CAR ARGS)
					(CEXP0
 (CADR ARGS)
					       CODE)
					T))
			  ((QUOTE *)
			    (CCON0
 (CAR ARGS)
				   CODE))
			  (COND (CCOND0
 ARGS CODE))
			  [AND (COND
				 ((CDR ARGS)
				   (CCOND0
 [LIST (LIST (CAR ARGS)
						       (CONS (QUOTE AND)
							     (CDR ARGS]
					   CODE))
				 (ARGS (CEXP0
 (CAR ARGS)
					      CODE))
				 (T (CBYTE0
 (OP#
 'T)
					    CODE]
			  (OR (CCOND0
 (MAPCAR ARGS (FUNCTION LIST))
				      CODE))
			  (SELECTQ (CSELQ0
 (CAR ARGS)
					   (CDR ARGS)
					   CODE))
			  (PROG (CPROG0
 (CAR ARGS)
					(CDR ARGS)
					CODE))
			  (GO (CGO0
 (CAR ARGS)
				    CODE))
			  (PROGN (CPROGN0
 ARGS CODE))
			  (PROG1 (CPROG10
 ARGS CODE))
			  (COND
			    ([NOT (EQUAL FORM (SETQ FORM (EXPANDMACRO FORM T]
			      (CEXP0
 FORM CODE))
			    (T (CCALL2
 FN 1 (CCON0
 ARGS CODE]
	      [1 (COND
		   ((AND (EQ FN (QUOTE FUNCTION))
			 (NULL (CDR ARGS)))
		     (CCON0
 (COND
			      ((LITATOM (CAR ARGS))
				(CAR ARGS))
			      (T (CLAM0
 (CAR ARGS)
					CODE)))
			    CODE))
		   ([NOT (EQUAL FORM (SETQ FORM (EXPANDMACRO FORM T]
		     (CEXP0
 FORM CODE))
		   (T (PROG ((ARGCNT 0))
			    [MAPC ARGS (FUNCTION (LAMBDA (X)
				      (SETQ CODE (CCON0
 X CODE))
				      (SETQ ARGCNT (ADD1 ARGCNT]
			    (RETURN (CCALL2
 FN ARGCNT CODE]
	      [NIL                 (* NO DEF)

		(SELECTQ
		  FN
		  (.ERRSETQ. (CERSET0
 (CAR ARGS)
				      (CADR ARGS)))
		  (COND
		    ([NOT (EQUAL FORM (SETQ FORM (EXPANDMACRO FORM T]
		      (CEXP0
 FORM CODE))
		    ([AND COMPILEUSERFN
			  (NOT (EQUAL FORM (SETQ FORM
					(PROG [(FN TOPFN)
					       (OTHERVARS (NCONC (MAPCAR IVARS
									 (FUNCTION CAR))
								 (MAPCAR PVARS
									 (FUNCTION CAR]
					      (RETURN (OR (APPLY* COMPILEUSERFN (CDR FORM)
								  FORM)
							  FORM]
		      (CEXP0
 FORM CODE))
		    (T (CCALL1
 FN ARGS CODE))
		    (T (CCALL2
 (QUOTE \EVALFORM)
			       1
			       (CCON0
 FORM CODE]
	      (2 (CCALL1
 FN ARGS CODE))
	      (SHOULDNT])

(CERSET0

  [LAMBDA (FORM FLG)                                         (* lmm "17-FEB-82 12:46")

    (CCALL2
 (QUOTE ERRORSET)
	    2
	    (CCON0
 FLG (CCON0
 [COND
				((AND (NULL (CDR FORM))
				      (LITATOM (CAR FORM)))
				  FORM)
				(T (LIST (CLAM0
 (LIST (QUOTE LAMBDA)
						      NIL FORM)
						CODE]
			      CODE])

(CCALL2

  [LAMBDA (FN ARGCNT CODE)         (* lmm "13-FEB-83 15:54")

    (PROG (TEM)
          [COND
	    [(LITATOM FN)
	      (COND
		((SETQ TEM (GETPROP FN (QUOTE FCOMPILE)))
		  (COND
		    ((LISTP TEM)
		      (SETQ CODE (CADJUST0
 ARGCNT (CAR TEM)
					   CODE))
		      [MAPC (CDR TEM)
			    (FUNCTION (LAMBDA (X)
				(SETQ CODE (CBYTE0
 (CAR (\FINDOP X))
						   CODE]
		      (RETURN CODE))
		    ((IGREATERP ARGCNT 0)
		      (FRPTQ (SUB1 ARGCNT)
			     (SETQ CODE (CBYTE0
 (CAR (\FINDOP TEM))
						CODE)))
		      (RETURN CODE]
	    ((EQ (CAR FN)
		 (QUOTE LAMBDA))
	      (RETURN (CLAM01
 FN ARGCNT CODE)))
	    (T (SETQ FN (CLAM0
 FN CODE]
          (SETQ FN (\ATOMDEFINDEX FN))
          (RETURN (CBYTE0
 (LOGAND FN 377Q)
			  (CBYTE0
 (LRSH FN 10Q)
				  (CBYTE0
 (SELECTQ ARGCNT
						   (3 (OP#
 FN3))
						   (2 (OP#
 FN2))
						   (1 (OP#
 FN1))
						   (4 (OP#
 FN4))
						   (0 (OP#
 FN0))
						   (PROGN (SETQ CODE (CBYTE0
 (OP#
 FNX)
									     CODE))
							  ARGCNT))
					  CODE])

(CLAM01

  [LAMBDA (FN ARGCNT CODE)                                   (* lmm "17-FEB-82 00:30")

    (SETQ CODE (CADJUST0
 ARGCNT (SETQ ARGCNT (LENGTH (CADR FN)))
			 CODE))
    (COND
      ((EQ ARGCNT 0)
	(CPROGN0
 (CDDR FN)
		 CODE))
      (T (PROG ((CURRENTPVARS CURRENTPVARS))
	       [MAPC (CADR FN)
		     (FUNCTION (LAMBDA (X)
			 (push
 CURRENTPVARS (CAR (push
 PVARS (CONS X (PROG1 PVARN (add
 PVARN 1]
	       (RETURN (CBYTE0
 (OP#
 UNBIND)
			       (CPROGN0
 (CDDR FN)
					(CBYTE0
 (SUB1 PVARN)
						(CBYTE0
 ARGCNT (CBYTE0
 (OP#
 BIND)
								       CODE])

(CADJUST0

  [LAMBDA (NHAVE NWANT CODE)       (* lmm "17-FEB-82 00:01")

    (FRPTQ (IDIFFERENCE NHAVE NWANT)
	   (SETQ CODE (CBYTE0
 (OP#
 POP)
			      CODE)))
    (FRPTQ (IDIFFERENCE NWANT NHAVE)
	   (SETQ CODE (CBYTE0
 (OP#
 'NIL)
			      CODE)))
    CODE])

(CCALL1

  [LAMBDA (FN ARGS CODE)           (* lmm "13-FEB-82 14:13")

    (PROG ((ARGCNT 0))
          [MAPC ARGS (FUNCTION (LAMBDA (X)
		    (SETQ CODE (CEXP0
 X CODE))
		    (SETQ ARGCNT (ADD1 ARGCNT]
          (RETURN (CCALL2
 FN ARGCNT CODE])

(CCOND0

  [LAMBDA (CLAUSES CODE)           (* lmm "18-FEB-82 21:43")

    (PROG (R J)
      LP  [COND
	    ((NULL CLAUSES)
	      (RETURN (JFIX0
 R (CBYTE0
 (OP#
 'NIL)
				       CODE]
          (SETQ CODE (CEXP0
 (CAAR CLAUSES)
			    CODE))
          [push
 R (SETQ CODE (COND
		    [(CDAR CLAUSES)
		      (SETQ J (CJUMPX
 (CBYTE0
 (IPLUS (OP#
 TJUMP)
						     2)
					      CODE)))
		      (JFIX0
 (LIST J)
			     (CJUMPX
 (CPROGN0
 (CDAR CLAUSES)
					      J]
		    (T (CJUMPX
 (CBYTE0
 (IPLUS (OP#
 JUMP)
					      2)
				       (CBYTE0
 3 (CBYTE0
 (OP#
 NTJUMPX)
							 CODE]
          (SETQ CLAUSES (CDR CLAUSES))
          (GO LP])

(CJUMPX

  [LAMBDA (CODE)                   (* lmm "18-FEB-82 21:42")

    (CBYTE0
 0 (CBYTE0
 0 (CBYTE0
 (OP#
 JUMPXX)
				CODE])

(JFIX0

  [LAMBDA (REFS CODE)              (* lmm "12-FEB-82 23:18")

    [MAPC REFS (FUNCTION (LAMBDA (C)
	      (SETQ C (SUB1 C))
	      (PROG [(D (IDIFFERENCE CODE (IDIFFERENCE C 2]
		    (CODESETA \FCCODEARRAY C (LOGAND D 255))
		    (CODESETA \FCCODEARRAY (SUB1 C)
			      (LRSH (LOGAND D 65280)
				    8]
    CODE])

(CBYTE0

  [LAMBDA (BYTE I)                                           (* lmm "17-FEB-82 15:39")

    (COND
      ((IGEQ I \FCCODESIZE)
	(GROWFCCODE
 100)))
    (CODESETA \FCCODEARRAY I BYTE)
    (ADD1 I])
)

(RPAQ \FCCODEARRAY
 (\CODEARRAY \FCCODESIZE 0))
(DECLARE: EVAL@COMPILE DONTCOPY 

(ADDTOVAR NOFIXVARSLST
 GVAR_ PVAR_ PVARX_ IVARX_ FVARX_ 'NIL 'T '0 '1 PVAR_^)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \FCCODESIZE \FCCODEARRAY)
)
)
(DECLARE: EVAL@COMPILE 


(PUTPROPS OP# MACRO 
(X
  
(
CAR
 (
\FINDOP
 (
CAR
 X)))))
)
(SETTEMPLATE (QUOTE OP#)
	     (QUOTE (NIL)))


(PUTPROPS CADR FCOMPILE 
(1 CDR CAR))



(PUTPROPS CAR FCOMPILE 
(1 CAR))



(PUTPROPS CDR FCOMPILE 
(1 CDR))



(PUTPROPS IPLUS FCOMPILE 
IPLUS2)



(PUTPROPS IDIFFERENCE FCOMPILE 
(2 IDIFFERENCE))



(PUTPROPS SUB1 FCOMPILE 
(1 '1 IDIFFERENCE))



(PUTPROPS EQ FCOMPILE 
(2 EQ))



(PUTPROPS LISTP FCOMPILE 
(1 LISTP))



(PUTPROPS NEQ FCOMPILE 
(2 EQ 'NIL EQ))



(PUTPROPS NLISTP FCOMPILE 
(1 LISTP 'NIL EQ))



(PUTPROPS NULL FCOMPILE 
(1 'NIL EQ))



(PUTPROPS NOT FCOMPILE 
(1 'NIL EQ))



(PUTPROPS \GETBASEPTR FCOMPILE 


  (2 ADDBASE GETBASEPTR.N 0))


(PUTPROPS ILESSP FCOMPILE 
(2 SWAP IGREATERP))



(PUTPROPS IGREATERP FCOMPILE 
(2 IGREATERP))

(MOVD? (QUOTE NILL)
       (QUOTE ADDREF))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 OP#)

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 )
)
(PUTPROPS LLFCOMPILE COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1358 6525 (COMPST0 1368 . 4226) (FCOMPILERR 4228 . 4357) (GROWFCCODE 4359 . 4727) (OP# 
4729 . 4829) (\ARGCHECK 4831 . 5224) (\ARGCHECKFAIL 5226 . 5440) (\MAKEPSEUDOCODE 5442 . 6297) (
\PSEUDOCODE.REALDEF 6299 . 6523)) (6526 20218 (FCOMPILE 6536 . 7131) (FCOMPILE2 7133 . 7294) (COMP0 
7296 . 7435) (COMP0DEF 7437 . 8223) (CEXP0 8225 . 8379) (CEXPA0 8381 . 8536) (CATOM0 8538 . 9642) (
CCON0 9644 . 10647) (CFIXCON0 10649 . 10812) (CPROG0 10814 . 11877) (CGO0 11879 . 12251) (CRETURN0 
12253 . 12562) (CPROG10 12564 . 12815) (CPROGN0 12817 . 13173) (CLAM0 13175 . 13309) (CSELQ0 13311 . 
13848) (CCALL0 13850 . 16233) (CERSET0 16235 . 16582) (CCALL2 16584 . 17654) (CLAM01 17656 . 18270) (
CADJUST0 18272 . 18552) (CCALL1 18554 . 18813) (CCOND0 18815 . 19520) (CJUMPX 19522 . 19670) (JFIX0 
19672 . 20001) (CBYTE0 20003 . 20216)))))
STOP