(FILECREATED "16-Aug-85 07:14:46" {ERIS}<LISPCORE>SOURCES>LLFCOMPILE.;3 23366
changes to: (FNS COMP0DEF CCALL0 \MAKEPSEUDOCODE CCALL2)
(VARS LLFCOMPILECOMS FCOMPILEMACROPROPS)
(PROPS (FUNCALL FCOMPILE-MACRO)
(.ERRSETQ. FCOMPILE-MACRO))
previous date: "27-Sep-84 23:09:44" {ERIS}<LISPCORE>SOURCES>LLFCOMPILE.;1)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LLFCOMPILECOMS)
(RPAQQ LLFCOMPILECOMS ((DECLARE: FIRST (VARS (COMPILEATPUTDFLG)))
(VARS FCOMPILEMACROPROPS (\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)))
(PROP FCOMPILE-MACRO .ERRSETQ. FUNCALL)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA OP#)
(NLAML)
(LAMA)))))
(DECLARE: FIRST
(RPAQQ COMPILEATPUTDFLG NIL)
)
(RPAQQ FCOMPILEMACROPROPS (FCOMPILE-MACRO OPTIMIZER DMACRO ALTOMACRO BYTEMACRO MACRO))
(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) (* lmm "16-Aug-85 06:11")
(AND COMPILEATPUTDFLG (DEFINEDP (QUOTE COMP0DEF))
(PROG ((RETLOC (QUOTE \MAKEPSEUDOCODE)))
(RETURN (AND (LISTP LAM)
(LISTP (CDR LAM))
(fetch (ARRAYP BASE)
of (COMP0DEF TOPFN (LIST (CAR LAM)
(CADR LAM)
(SELECTQ COMPILEATPUTDFLG
(ALL (CONS (QUOTE PROGN)
(CDDR LAM)))
(LIST (QUOTE \EVPROGN)
(KWOTE (CDDR LAM)))))
0))))))))
(\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 "16-Aug-85 07:10")
(PROG NIL
RETRY
(SELECTQ (CAR DEF)
((LAMBDA NLAMBDA))
(COND
((SETQ DEF (APPLY* COMPILEUSERFN NIL DEF))
(GO RETRY))
(T (RETFROM RETLOC))))
(RETURN (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 "16-Aug-85 07:14")
(LET* ((ARGS (CDR FORM))
(FN (CAR FORM))
(MACRO (GETMACROPROP FN FCOMPILEMACROPROPS)))
(if (AND MACRO (OR (LISTP (CAR MACRO))
(NOT (FMEMB (CAR MACRO)
(QUOTE (APPLY APPLY*)))))
(NEQ FORM (SETQ FORM (MACROEXPANSION FORM MACRO T))))
then (CEXP0 FORM CODE)
else
(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))
((AND (EQ FN (QUOTE ARG))
NIL))
(T (LET ((ARGCNT 0))
(MAPC ARGS (FUNCTION (LAMBDA (X)
(SETQ CODE (CCON0 X CODE))
(SETQ ARGCNT (ADD1 ARGCNT)))))
(CCALL2 FN ARGCNT CODE)))))
(NIL
(SELECTQ
FN
(.ERRSETQ. (CERSET0 (CAR ARGS)
(CADR ARGS)))
(COND
((AND COMPILEUSERFN
(NOT (EQUAL FORM (SETQ FORM
(LET ((FN TOPFN)
(OTHERVARS (NCONC (MAPCAR IVARS
(FUNCTION CAR))
(MAPCAR PVARS
(FUNCTION CAR)))))
(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 "16-Aug-85 06:46")
(PROG (TEM)
(COND
((LITATOM FN)
(COND
((AND (SETQ TEM (OR (GETPROP FN (QUOTE FCOMPILE))
(GETPROP FN (QUOTE DOPVAL))))
(FIXP (CAR TEM)))
(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 OPCODES))
(MAPC (CDR FN)
(FUNCTION (LAMBDA (X)
(SETQ CODE (CBYTE0 (CAR (\FINDOP X))
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 255)
(CBYTE0 (LRSH FN 8)
(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))
(PUTPROPS .ERRSETQ. FCOMPILE-MACRO T)
(PUTPROPS FUNCALL FCOMPILE-MACRO (DEFMACRO (FN &REST ARGS)
(BQUOTE ((OPCODES APPLYFN)
(\,@ ARGS)
(\, (LENGTH ARGS))
(\, FN)))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA OP#)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS LLFCOMPILE COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1655 6605 (COMPST0 1665 . 4523) (FCOMPILERR 4525 . 4654) (GROWFCCODE 4656 . 5024) (OP#
5026 . 5126) (\ARGCHECK 5128 . 5521) (\ARGCHECKFAIL 5523 . 5737) (\MAKEPSEUDOCODE 5739 . 6377) (
\PSEUDOCODE.REALDEF 6379 . 6603)) (6606 21838 (FCOMPILE 6616 . 7211) (FCOMPILE2 7213 . 7374) (COMP0
7376 . 7515) (COMP0DEF 7517 . 8791) (CEXP0 8793 . 8947) (CEXPA0 8949 . 9104) (CATOM0 9106 . 10210) (
CCON0 10212 . 11215) (CFIXCON0 11217 . 11380) (CPROG0 11382 . 12445) (CGO0 12447 . 12819) (CRETURN0
12821 . 13130) (CPROG10 13132 . 13383) (CPROGN0 13385 . 13741) (CLAM0 13743 . 13877) (CSELQ0 13879 .
14416) (CCALL0 14418 . 17356) (CERSET0 17358 . 17705) (CCALL2 17707 . 19274) (CLAM01 19276 . 19890) (
CADJUST0 19892 . 20172) (CCALL1 20174 . 20433) (CCOND0 20435 . 21140) (CJUMPX 21142 . 21290) (JFIX0
21292 . 21621) (CBYTE0 21623 . 21836)))))
STOP