(FILECREATED "13-FEB-83 16:38:35" <BLISP>LLFCOMPILE.;36 21526
changes to: (FNS COMPST0 CCON0 CCALL2)
previous date: "22-FEB-82 15:10:45" <BLISP>LLFCOMPILE.;35)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT LLFCOMPILECOMS)
(RPAQQ LLFCOMPILECOMS [(DECLARE: FIRST (VARS (COMPILEATPUTDFLG)))
(VARS (\FCCODESIZE 1356Q))
(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 ZEROP 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 1356Q)
(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
(ADDTOVAR 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 ZEROP FCOMPILE (1 '0 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" 3676Q 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1308 6475 (COMPST0 1318 . 4176) (FCOMPILERR 4178 . 4307) (GROWFCCODE 4309 . 4677) (OP# 4679 . 4779) (\ARGCHECK 4781
. 5174) (\ARGCHECKFAIL 5176 . 5390) (\MAKEPSEUDOCODE 5392 . 6247) (\PSEUDOCODE.REALDEF 6249 . 6473)) (6476 20168 (FCOMPILE 6486
. 7081) (FCOMPILE2 7083 . 7244) (COMP0 7246 . 7385) (COMP0DEF 7387 . 8173) (CEXP0 8175 . 8329) (CEXPA0 8331 . 8486) (CATOM0 8488
. 9592) (CCON0 9594 . 10597) (CFIXCON0 10599 . 10762) (CPROG0 10764 . 11827) (CGO0 11829 . 12201) (CRETURN0 12203 . 12512) (
CPROG10 12514 . 12765) (CPROGN0 12767 . 13123) (CLAM0 13125 . 13259) (CSELQ0 13261 . 13798) (CCALL0 13800 . 16183) (CERSET0 16185
. 16532) (CCALL2 16534 . 17604) (CLAM01 17606 . 18220) (CADJUST0 18222 . 18502) (CCALL1 18504 . 18763) (CCOND0 18765 . 19470) (
CJUMPX 19472 . 19620) (JFIX0 19622 . 19951) (CBYTE0 19953 . 20166)))))
STOP
OND0 45666Q . 47215Q) (CJUMPX 47221Q . 47450Q) (JFIX0 47454Q .
50176Q) (CBYTE0 50202Q . 50535Q)))))
STOP