NIL QUOTE 2 0 LABEL 0 0 LAMBDA 0 0 APVAL 0 0 SUBR 0 0 FSUBR 0 0 EXPR 0 0 FEXPR 0 0 STOP 0 0 EVAL 0 0 CAR 6 1 CDR 6 2 CAAR 6 3 CADR 6 4 CDAR 6 5 CDDR 6 6 CONS 6 7 LIST 6 8 COND 2 9 AND 2 10 OR 2 11 NOT 6 12 NULL 6 12 ATOM 6 13 NUMBERP 6 14 EVENP 6 56 ONEP 6 55 ZEROP 6 15 EQ 6 16 EQUAL 6 17 LESSP 6 18 GREATERP 6 19 MEMB 6 20 MEMQ 6 20 MEMBER 6 21 ASSOC 6 22 PLUS 6 23 DIFFERENCE 6 24 TIMES 6 25 QUOTIENT 6 26 ADD1 6 27 SUB1 6 28 READCH 6 29 ADVANCE 6 29 RATOM 6 30 READ 6 31 PRIN 6 32 PRINT 6 33 GET 6 34 PUT 6 35 PUTPROP 6 35 DEFPROP 2 35 EVAL 6 36 EVLIS 6 37 APPLY 2 38 RESET 6 39 RPLACA 6 40 RPLACD 6 41 SETQ 2 63 SET 6 64 UNPACK 6 42 EXPLODE 6 42 PACKLIST 6 43 READLIST 6 43 PROG 2 44 PROG2 2 45 PROGN 2 45 REVERSE 6 52 EXIT 6 53 TRACE 2 46 UNTRACE 2 47 INUNIT 6 48 OUTUNIT 6 49 RETURN 6 50 GO 2 51 PEEK 6 54 GARB 6 57 BREAK 2 58 UNBREAK 2 59 INPUT 6 60 OUTPUT 6 61 NIL 0 0 (PUT (QUOTE DF) [QUOTE (LAMBDA $$L (LIST (CAR $$L) (QUOTE =) (PUT (CAR $$L) (CONS (QUOTE LAMBDA) (CDR $$L)) (QUOTE FEXPR] (QUOTE FEXPR] (DF DE $$L (LIST (CAR $$L) (QUOTE =) (PUT (CAR $$L) (CONS (QUOTE LAMBDA) (CDR $$L)) (QUOTE EXPR] (DE CSET($$A $$B) (PUT $$A $$B (QUOTE APVAL] (DF DEFINE ($$A) (LIST (CAR $$A) (QUOTE =) (PUT (CAR $$A) (CADR $$A) (QUOTE EXPR] (DE APPEND($$A $$B) (COND ((NULL $$A) $$B) (T (CONS (CAR $$A) (APPEND (CDR $$A) $$B] (DF CSETQ ($$A $$B) (CSET $$A (EVAL $$B] (CSET 'T 'T) (CSET '% '%) (DF EDITF(FL) (EDIT (GETD FL] (DE EDIT (CTL) (PROG(X CL) (SETQ CL CTL) A (SETQ X (READ)) (COND((ATOM X) (GO B)) ((ATOM CL)(GO ERR)) ((NUMBERP(CAR X)) (XCHANGE CL X)) (T(XADJUST CL X))) (GO A) B (COND((ZEROP X) (SETQ CL CTL)) ((NUMBERP X) (COND ((OR(ATOM CL)(LESSP X 0)) (GO ERR)) ((NULL (SETQ X (NTH CL X))) (GO ERR)) (T(SETQ CL (CAR X))))) (T(SELECTQ X (OK(RETURN CTL)) (UP (SETQ CTL CL)) (P (SPRINT CL 2)) (PR (SPRINT CL (READ))) (GO ERR)) )) (GO A) ERR (PRINT ILLGC) (GO A))) (DE SPRINT(L N) (COND((OR (ATOM L)(ZEROP N)) (PRINT L)) (T (PRINT (SPRC L 0 N))))) (DE SPRC(L N1 N2)(COND((NULL L)NIL) ((GREATERP N1 N2)(QUOTE ***)) ((ATOM L) L) (T(CONS(SPRC(CAR L)(ADD1 N1) N2)(SPRC(CDR L)N1 N2 ))) )) (DE XCHANGE(L AL)(PROG(N X CL) (SETQ N (CAR AL)) (SETQ X (CDR AL)) (SETQ CL L) (COND((ATOM CL)(GO ERR)) ) (COND((GREATERP N 0) (COND((GREATERP N (LENGTH CL)) (GO ERR)) ((NULL X)(COND((EQ N 1)(SMASH CL (CADR CL)(CDDR CL))) (T(PROGN(SETQ CL(NTH CL (SUB1 N)))(RPLACD CL(CDDR CL)))))) (T(PROGN(SETQ CL (NTH CL N))(SMASH CL (CAR X)(NCONC(CDR X)(CDR CL)))) ))) ((OR(EQ N 0)(NULL X)(GREATERP (MINUS N)(LENGTH CL)))(GO ERR)) (T(PROGN(SETQ CL(NTH CL(MINUS N))) (SMASH CL (CAR X) (NCONC(CDR X)(CONS(CAR CL)(CDR CL))))) )) (RETURN NIL) ERR (RETURN(PRINT ILLGC)) )) (DE XADJUST(L AL)(PROG(X A B) (SETQ AL (COND ((NULL(CDR AL)) (LIST (CAR AL) 1)) (T AL)))(SELECTQ(CAR AL) (R(RETURN(RPLACEALL L (CDR AL)))) (F(RETURN(SETQ CL (FIND L (CADR AL))))) (SETQ X (NTH L(CADR AL)))) (COND((NULL X)(RETURN(PRINT ILLGC))) ) (RETURN (SELECTQ (CAR AL) (LO(SMASH X (CAAR X)(CDAR X))) (LI(SMASH X (CONS(CAR X)(CDR X)))) (RO(NCONC(CAR X)(CDR X)) (RPLACD X NIL)) (RI(SETQ A (NTH(CAR X)(CADDR AL)))(RPLACD X (NCONC(CDR A)(CDR X))) (RPLACD A NIL)) (BO(SMASH X (CAAR X)(NCONC(CDAR X)(CDR X)))) (BI(SETQ B (CDR(SETQ A(NTH L(CADDR AL)) ))) (RPLACD A NIL) (SMASH X (CONS(CAR X)(CDR X))B)) (PRINT ILLGC))) )) (DE SMASH(X A B)(PROGN(RPLACA X A)(RPLACD X B))) (DE RPLACEALL(L RL)(COND((ATOM L) NIL) ((EQUAL(CAR L)(CAR RL)) (PROGN(SMASH L (CADR RL)(NCONC(CDDR RL)(CDR L)))(RPLACEALL(CDR L)RL))) (T(PROGN(RPLACEALL(CAR L)RL)(RPLACEALL(CDR L)RL))))) (DE FIND(L A)(COND((ATOM L)NIL)((EQUAL (CAR L) A) L) (T(TRY (FIND(CAR L) A)(FIND (CDR L) A))))) (DF SELECTQ (M.RL) (EVLAST(SELECTQ1(EVAL M) RL) )) (DE SELECTQ1(M L)(PROG(C) LP (SETQ C L) (COND((NULL(SETQ L (CDR L))) (RETURN C)) ((OR(EQ(CAR(SETQ C(CAR C)))M) (AND(NULL(ATOM(CAR C)))(MEMB M(CAR C))))(RETURN (CDR C)))) (GO LP) )) (DE EVLAST (LX) (COND((NULL(CDR LX))(EVAL(CAR LX))) (T(PROGN(EVAL(CAR LX) )(EVLAST(CDR LX) ))))) (DE GETD(A)(PROG(X)(COND((SETQ X (GET A (QUOTE EXPR))) X) ((SETQ X (GET A (QUOTE FEXPR))) X) ))) (DE NTH(L N)(PROG () A (COND((LESSP N 2)(RETURN L))((NULL L)(RETURN NIL))) (SETQ L (CDR L)) (SETQ N(SUB1 N)) (GO A))) (DE MINUS(N)(DIFFERENCE 0 N)) (DE LENGTH (S)(PROG(N) (SETQ N 0) A(COND((NULL S)(RETURN N))) (SETQ S (CDR S)) (SETQ N (ADD1 N)) (GO A))) (DE TRY L (PROG NIL LOOP (COND ((ATOM L) (RETURN NIL)) ((CAR L) (RETURN (CAR L))) (T (SETQ L (CDR L)) (GO LOOP] (DE NCONC (A B) (PROG (C) (COND ((NULL A) (RETURN B)) (T (SETQ C A)) LOOP (COND ((NULL (CDR C)) (REPLACD C B) (RETURN A)) (T (SETQ C (CDR C)) (GO LOOP] (DE CADDR (X)(CAR(CDDR X))) (CSET(QUOTE ILLGC)(QUOTE (WRONG TRY AGAIN))) (CSET 'NIL 'NIL)