(CSETQ COMPILE
(LAMBDA (V-L . V-LIST)
        (PROG <V-C V-IND V-ATS V-AT>
              <CSETQ K-FREE NIL>
         LOOP <COND [(NULL V-L) (RETURN
                                 (COND [K-FREE]
                                       [T]))]>
              <SETQ V-C (CAR V-L)>
              <SETQ V-L (CDR V-L)>
              <COND [(ATOM V-C)
                      (CM-PILE V-C V-C V-LIST)
                      (GO LOOP)]>
              <SETQ V-IND (CAR V-C)>
              <SETQ V-ATS (CDR V-C)>
        PLOOP <COND [(NULL V-ATS) (GO LOOP)]>
              <SETQ V-C (GENSYM (SETQ V-AT (CAR V-ATS)))>
              <CSET V-C (GET V-AT V-IND)>
              <CM-PILE V-C (LIST V-IND V-AT) V-LIST>
              <PUT V-AT V-IND (*CAR V-C)>
              <SETQ V-ATS (CDR V-ATS)>
              <GO PLOOP>)))

(CSETQ CM-PILE
(LAMBDA (V-C V-NM V-LIST)
        (PROG <V-I V-T>
              <COND [(OR (SETQ V-I (*DEF V-C))
                         (SETQ V-I (*DEF (RPLACA 0Q (*SPEC V-C))))
                         (SETQ V-I (*DEF (RPLACA 0Q (*MACRO V-C)))))
                      (SETQ V-T (F-FUNC V-C V-I NIL NIL NIL))
                      (COND [V-LIST (CM-LIST V-NM V-T)])
                      (COND [(*DEF V-C) (CSET V-C (CM-EMIT V-T))]
                            [T (RPLACD (*CDR (ADD1 (RPLACD 0Q (*CAR V-C)
                                ))) (CM-EMIT V-T))])]
                    [T (PRIN1 "CAN'T COMPILE ")
                       (PRINT V-NM)]>)))

(CSETQ CM-LIST
(LAMBDA (V-NM V-T)
        (PROG <V-I>
              <PRIN1 V-NM>
              <PRIN1 "  [">
              <PRIN1 (RPLACD 0Q V-NM)>
              <PRINT "]">
        PRINT <COND [(NULL V-T) (RETURN T)]>
              <SETQ V-I (CAR V-T)>
              <SETQ V-T (CDR V-T)>
              <SETQ V-NM 6>
         EDIT <COND [(ATOM V-I)
                      (TERPRI)
                      (GO PRINT)]
                    [T (PRIN1 (CAR V-I) V-NM)]>
              <SETQ V-I (CDR V-I)>
              <SETQ V-NM (PLUS V-NM 14)>
              <GO EDIT>)))
(CSETQ CM-EMIT
(LAMBDA (V-T)
        (PROG <V-I V-L>
              <CSETQ K-BACK (CSETQ K-REGS NIL)>
              <CSETQ K-CODE V-T>
              <*BEGIN>
         NEXT <COND [(NULL K-CODE) (GO PLUG)]>
              <SETQ V-I (CAR K-CODE)>
              <CSETQ K-CODE (CDR K-CODE)>
              <SETQ V-L (GET (CAR V-I) X-EMIT)>
              <COND [(NULL (CDR V-I))
                      (V-L)
                      (GO NEXT)]
                    [(IFFLAG (CAR V-I) X-ASG)
                      (SETQ V-T (E-REG (CADR V-I) NIL))]
                    [T (SETQ V-T (CADR V-I))]>
              <V-L (STACK (RPLACA (CDR V-I) V-T))>
              <GO NEXT>
         PLUG <COND [(NULL K-BACK) (RETURN (*BEGIN))]
                    [(SETQ V-L (GET (CAAR K-BACK) X-LAB))
                      (RPLACD (CDAR K-BACK) V-L)]>
              <CSETQ K-BACK (CDR K-BACK)>
              <GO PLUG>)))

(CSETQ EXCISE
(LAMBDA NIL
        (CSETQ COMPILE NIL)
        (MAPC CM-DUMP
         (LAMBDA (V-A)
                 (COND [(ATOM V-A) (CSETQ COMPILE (CONS V-A COMPILE))]))
         )
        (ERASE COMPILE)
        (OBLIST
         (LAMBDA (V-A)
                 (UNFLAG V-A 'X-ASG)
                 (UNFLAG V-A 'X-DONT)
                 (UNFLAG V-A 'X-FLU)
                 (UNFLAG V-A 'X-CON)
                 (UNFLAG V-A 'X-INDX)
                 (REMPROP V-A 'X-LEAP)
                 (REMPROP V-A 'X-LAB)
                 (REMPROP V-A 'X-REG)
                 (REMPROP V-A 'X-SPF)
                 (REMPROP V-A 'X-SPFN)
                 (REMPROP V-A 'X-SPFH)
                 (REMPROP V-A 'X-OPT)
                 (REMPROP V-A 'X-EMIT)))
        T))

(CSETQ FLUID
(LAMBDA (V-L)
        (MAPC V-L
         (LAMBDA (V-A)
                 (UNFLAG V-A X-CON)
                 (FLAG V-A X-FLU)))
        T))

(CSETQ UNFLUID
(LAMBDA (V-L)
        (MAPC V-L
         (LAMBDA (V-A)
                 (UNFLAG V-A X-FLU)))
        T))

(CSETQ F-EXP
(LAMBDA (V-E V-R V-T)
        (PROG <V-F V-I>
        BEGIN <COND [(F-ONE V-E)
                      (RETURN (F-ADD V-T 'GET V-R (F-VBLE V-E V-R)))]
                    [(NOT (ATOM (SETQ V-F (CAR V-E))))
                      (COND [(EQ (CAAR V-T) 'RETURN) (GO NORMAL)]
                            [(SETQ V-I (F-CHKF V-F 1))
                              (SETQ V-E (CONS V-I (CDR V-E)))])
                      (GO NORMAL)]
                    [(SETQ V-I (GET V-F X-SPF)) (GO SPECIAL)]
                    [(ASSOC 'STACK (CDR V-E)) (GO NORMAL)]
                    [(SETQ V-I (GET V-F X-SPFN)) (GO SPECIAL)]
                    [(SETQ V-I (GET V-F X-SPFH))
                      (COND [(EQ (CAAR V-T) 'RETURN) (GO NORMAL)])
                      (SETQ V-E (V-I V-E))
                      (GO NORMAL)]
                    [(*SPEC V-F)
                      (SETQ V-E (LIST V-F (LIST 'QUOTE (CDR V-E))))
                      (GO NORMAL)]
                    [(SETQ V-I (*MACRO V-F))
                      (SETQ V-E (V-I (STACK (CDR V-E))))
                      (GO BEGIN)]
                    [(SETQ V-I (*CHAIN V-F))
                      (SETQ V-T (F-ADD V-T 'CHAIN V-R (SETQ V-R (F-REG
                       X-INDX)) V-I))
                      (SETQ V-E (CADR V-E))
                      (GO BEGIN)]
                    [(NOT (EQ (CAAR V-T) 'RETURN)) (GO NORMAL)]
                    [(OR (EQ (SETQ V-I W-BV) T)
                         (NOT (EQ V-F W-NAME))) (GO NORMAL)]
                    [(NOT (F-ITER (CDR V-E) (REVERSE V-I))) (GO NORMAL)]
               >
              <SETQ V-T (F-ADD V-T 'REPEAT)>
              <SETQ V-E (REVERSE (CDR V-E))>
      ITERATE <COND [(NULL V-E) (RETURN V-T)]
                    [(EQ (CAR V-E) (CAR V-I)) (GO NEXT)]>
              <SETQ V-T (F-ADD V-T 'SET (SETQ V-R (F-REG NIL)) (CAR V-I)
               )>
              <SETQ V-T (F-EXP (CAR V-E) V-R V-T)>
         NEXT <SETQ V-E (CDR V-E)>
              <SETQ V-I (CDR V-I)>
              <GO ITERATE>
      SPECIAL <COND [(SETQ V-I (V-I (CDR V-E) V-R V-T)) (RETURN V-I)]>
       NORMAL <SETQ V-T (F-ADD V-T 'CALL (F-MAKE V-R R-XV))>
              <SETQ V-T (F-PUSH V-E (F-REG NIL) V-T)>
              <RETURN (F-ADD V-T 'MARK)>)))

(CSETQ F-SPLAMB
(LAMBDA (V-L V-R V-T)
        (F-LAMB (CDR V-L) V-R (CAR V-L) V-T)))

(CSETQ F-LAMB
(LAMBDA (V-L V-R V-ETYP V-T)
        (PROG <V-X>
              <FLAG V-R X-INDX>
              <SETQ V-T (F-LEAP V-T)>
              <SETQ V-X (CADR S-INST)>
              <SETQ V-T (F-FUNC (GENSYM 'LAMBDA) V-L V-ETYP V-T)>
              <RETURN (F-ADD V-T 'SKIP V-R V-X)>)))

(CSETQ F-FUNC
(LAMBDA (W-NAME V-L V-ETYP V-T)
        (F-ADD (F-LAM (CAR V-L)
         (COND [V-ETYP W-VARS]) (CDR V-L) G-XV (F-ADD (F-ADD V-T 'END
         NIL) 'RETURN G-EXIT)) 'ENTRY V-ETYP)))

(CSETQ F-LAM
(LAMBDA (V-V V-BV V-B V-R V-T)
        (PROG <V-L W-VARS W-BV>
         LOOP <COND [(ATOM V-V) (GO LAST)]>
              <SETQ V-L (CONS (CAR V-V) V-L)>
              <COND [(IFFLAG (CAR V-V) X-FLU) (SETQ W-BV T)]>
              <SETQ V-BV (CONS (CAR V-V) V-BV)>
              <SETQ V-V (CDR V-V)>
              <GO LOOP>
         LAST <COND [V-V (SETQ W-BV T)
                         (SETQ V-BV (CONS V-V V-BV))]
                    [(NOT W-BV) (SETQ W-BV V-L)]>
              <SETQ W-VARS V-BV>
              <SETQ V-T (F-SEQ V-B V-R V-T)>
              <COND [(NULL V-V) (GO BIND)]>
              <SETQ V-T (F-ADD V-T 'BIND V-V)>
              <SETQ V-T (F-ADD V-T 'PUSH G-XV)>
              <SETQ V-T (F-ADD V-T 'LIST)>
         BIND <COND [(NULL V-L) (RETURN V-T)]>
              <SETQ V-T (F-ADD V-T 'BIND (CAR V-L))>
              <SETQ V-L (CDR V-L)>
              <GO BIND>)))

(CSETQ F-PRG
(LAMBDA (V-V V-BV V-S W-RET V-T)
        (PROG <V-L V-X V-F W-VARS (W-LABS (GENSYM)) W-ATMT>
              <SETQ V-S (REVERSE V-S)>
         LOOP <COND [(NULL V-V) (GO BODY)]>
              <SETQ V-X (CAR V-V)>
              <SETQ V-V (CDR V-V)>
              <COND [(ATOM V-X) (SETQ V-F NIL)]
                    [T (SETQ V-F (CADR V-X))
                       (SETQ V-X (CAR V-X))]>
              <SETQ V-BV (CONS V-X V-BV)>
              <SETQ V-L (CONS (CONS V-X V-F) V-L)>
              <GO LOOP>
         BODY <SETQ W-VARS V-BV>
              <SETQ V-T (F-ADD V-T 'GET (CAR W-RET) NIL)>
         STAT <COND [(NULL V-S) (GO BIND)]
                    [(ATOM (CAR V-S)) (SETQ V-T (F-LABL V-T (CAR V-S)))]
                    [T (SETQ V-T (F-EXP (CAR V-S) (F-REG NIL) V-T))]>
              <SETQ V-S (CDR V-S)>
              <GO STAT>
         BIND <COND [(NULL V-L) (RETURN (F-ADD V-T 'BEGIN))]> 
              <SETQ V-T (F-ADD V-T 'BIND (CAAR V-L))>
              <SETQ V-T (F-EXP (CDAR V-L) G-XV (F-ADD V-T 'PUSH G-XV))>
              <SETQ W-VARS (CDR W-VARS)>
              <SETQ V-L (CDR V-L)>
              <GO BIND>)))

(CSETQ F-IF
(LAMBDA (V-L V-R V-J V-T)
        (COND [(EQ (CAAR V-L) 'T)
                (COND [(NULL (CDAR V-L)) (F-EXP T V-R V-T)]
                      [T (F-SEQ (CDAR V-L) V-R V-T)])]
              [T (PROG <(V-TR (F-REG NIL)) V-I (V-DV 'ARB)>
                       <COND [(NULL (CDR V-L))
                               (SETQ V-TR V-R)
                               (COND [(NULL (CDAR V-L)) (GO LOOP2)])
                               (SETQ V-DV NIL)
                               (SETQ V-I (CADR V-J))]
                             [(NULL (CDAR V-L))
                               (SETQ V-TR V-R)
                               (SETQ V-T (F-IF (CDR V-L) V-R V-J V-T))
                               (SETQ V-T (F-ADD V-T 'TRUE V-R (CADR V-J)
                                T))
                               (GO LOOP1)]
                             [T (SETQ V-T (F-LEAP (F-IF (CDR V-L) V-R
                                 V-J V-T)))
                                (SETQ V-T (F-ADDI V-J V-T))
                                (SETQ V-I (CADR S-INST))]>
                       <SETQ V-T (F-SEQ (CDAR V-L) V-R V-T)>
                       <SETQ V-T (F-ADD V-T 'FALSE V-TR V-I V-DV)>
                 LOOP1 <SETQ V-T (F-ADD V-T 'MINUS V-TR NIL)>
                 LOOP2 <RETURN (F-EXP (CAAR V-L) V-TR V-T)>)])))

(CSETQ F-SEQ
(LAMBDA (V-L V-R V-T)
        (COND [(NULL V-L) V-T]
              [T (F-EXP (CAR V-L) V-R (F-SEQ (CDR V-L) V-R V-T))])))

(CSETQ F-PUSH
(LAMBDA (V-L V-R V-T)
        (COND [(NULL V-L) V-T]
              [T (F-EXP (CAR V-L) V-R (F-ADD (F-PUSH (CDR V-L) (F-REG
                  NIL) V-T) 'PUSH V-R))])))

(CSETQ F-CHKF
(LAMBDA (V-F V-N)
        (PROG <V-X>
         LOOP <COND [(ATOM V-F) (RETURN F)]
                    [(OR (EQ (SETQ V-X (CAR V-F)) 'LAMBDA)
                         (EQ V-X 'LAMDA))
                      (RETURN (CONS (PUT (GENSYM) 'X-SPF F-SPLAMB) (CONS
                       V-N (CDR V-F))))]
                    [(EQ V-X 'FUNCTION)
                      (SETQ V-F (CADR V-F))
                      (GO LOOP)]
                    [T (RETURN F)]>)))

(CSETQ F-ITER
(LAMBDA (V-E V-V)
        (PROG <V-X V-Y W-VARS>
         LOOP <COND [(NULL V-E) (RETURN T)]
                    [(NULL V-V) (RETURN F)]
                    [(IFFLAG (SETQ V-Y (CAR V-V)) X-FLU) (RETURN F)]
                    [(EQ V-Y (SETQ V-X (CAR V-E))) (GO USABLE)]
                    [(NOT (F-NICE V-X)) (RETURN F)]>
              <SETQ W-VARS (CONS V-Y W-VARS)>
       USABLE <SETQ V-E (CDR V-E)>
              <SETQ V-V (CDR V-V)>
              <GO LOOP>)))

(CSETQ F-NICE
(LAMBDA (V-E)
        (COND [(ATOM V-E) (NOT (MEMBER V-E W-VARS))]
              [(ATOM (CAR V-E))
                (COND [(EQ (CAR V-E) 'QUOTE) T]
                      [(IFFLAG (CAR V-E) X-DONT) F]
                      [T (F-ALL V-E F-NICE)])]
              [T (F-ALL V-E F-NICE)])))

(CSETQ F-ALL
(LAMBDA (V-L V-F)
        (COND [(NULL V-L) T]
              [(V-F (CAR V-L)) (F-ALL (CDR V-L) V-F)]
              [T F])))

(CSETQ F-MAKE
(LAMBDA (V-R V-V)
        (PUT V-R X-REG V-V)))

(CSETQ F-LEAP
(LAMBDA (V-T)
        (COND [(NOT (CSETQ S-INST (GET (CAAR V-T) X-LEAP)))
                (SETQ V-T (F-LABL V-T NIL))
                (CSETQ S-INST 'GO)])
        (CSETQ S-INST (LIST S-INST (CADAR V-T)))
        V-T))

(CSETQ F-LABL
(LAMBDA (V-T V-L)
        (PROG <V-I>
              <COND [(EQ (CAAR V-T) 'LABEL) (GO PICK)]
                    [(NULL V-L)
                      (SETQ V-I (GENSYM 'J))
                      (GO ON)]
                    [(SETQ V-I (GET W-LABS V-L)) (GO ON)]>
              <PUT W-LABS V-L (SETQ V-I (GENSYM V-L))>
              <GO ON>
         PICK <COND [(NULL V-L) (RETURN V-T)]
                    [(SETQ V-I (GET W-LABS V-L)) (GO ON)]>
              <PUT W-LABS V-L (SETQ V-I (CADAR V-T))>
           ON <RETURN (F-ADD V-T 'LABEL V-I)>)))

(CSETQ F-TEST
(LAMBDA (V-T)
        (AND (EQ (CAAR V-T) 'MINUS)
             (NULL (CADDAR V-T)))))

(CSETQ F-VBLE
(LAMBDA (V-V V-R)
        (COND [(NOT (IFTYPE V-V 7)) V-V]
              [(F-CON V-V) V-V]
              [(IFFLAG V-V X-FLU) V-V]
              [(MEMBER V-V W-VARS) V-V]
              [T (CSETQ K-FREE (CONS V-V K-FREE))
                 (FLAG V-V X-CON)])))

(CSETQ F-ADD
(LAMBDA (V-T . V-I)
        (F-ADDI V-I V-T)))

(CSETQ F-ADDI
(LAMBDA (V-I V-T)
        (PROG <V-O>
              <COND [(NOT (SETQ V-O (GET (CAR V-I) X-OPT))) (GO NORMAL)]
                    [(SETQ V-O (V-O V-I V-T)) (RETURN V-O)]>
       NORMAL <RETURN (CONS V-I V-T)>)))

(CSETQ F-REG
(LAMBDA (V-F)
        (FLAG (GENSYM 'R) V-F)))

(CSETQ F-CON
(LAMBDA (V-V)
        (OR (NOT (EQ (*CAR V-V) (*CAR 0)))
            (IFFLAG V-V X-CON))))

(CSETQ F-ONE
(LAMBDA (V-E)
        (OR (ATOM V-E)
            (EQ (CAR V-E) 'QUOTE))))

(CSETQ F-SWAP
(LAMBDA (V-T)
        (COND [(EQ (CAAR V-T) 'GET)
                (F-SWAP (CDR V-T))
                V-T]
              [T (RPLACA (CAR V-T)
                  (COND [(EQ (CAAR V-T) 'TRUE) 'FALSE]
                        [T 'TRUE]))
                 V-T])))

(CSETQ F-XVAL
(LAMBDA (V-T V-R)
        (COND [(OR (EQ (CAAR V-T) 'GET)
                   (EQ (CADDDAR V-T) 'ARB)) V-T]
              [T (F-ADD V-T 'GET V-R (CADDDAR V-T))])))

(CSETQ F-CHOP
(LAMBDA (V-T)
        (COND [(OR (EQ (CAAR V-T) 'LABEL)
                   (EQ (CAAR V-T) 'END)) V-T]
              [T (F-CHOP (CDR V-T))])))

(CSETQ F-TFO
(LAMBDA (V-I V-T)
        (COND [(NOT (F-LIKE V-T '(GO LABEL))) NIL]
              [(NOT (EQ (CADDR V-I) (CADADR V-T))) NIL]
              [T (RPLACA (CDDR V-I) (CADAR V-T))
                 (F-SWAP (RPLACA V-T V-I))])))

(CSETQ F-LIKE
(LAMBDA (V-T V-P)
        (COND [(NULL V-P) T]
              [(NULL V-T) F]
              [(EQ (CAAR V-T) (CAR V-P)) (F-LIKE (CDR V-T) (CDR V-P))]
              [T F])))

(CSETQ F-AOR
(LAMBDA (V-L V-E V-R V-T)
        (COND [(NULL V-L)
                (F-ADD V-T 'GET V-R (EQ V-E 'AND))]
              [T (PROG <V-J (V-DV (EQ V-E 'OR)) (V-TR V-R) (V-TR2 V-R)>
                       <SETQ V-E
                        (COND [(EQ V-E 'AND) 'FALSE]
                              [T 'TRUE])>
                       <SETQ V-L (REVERSE V-L)>
                       <COND [(NULL (CDR V-L)) (GO LOOP)]
                             [(AND (F-TEST V-T)
                                   (NOT (EQ (CAADR V-T) 'GET)))
                               (COND [(EQ (CADDDADR V-T) 'ARB)
                                       (SETQ V-DV 'ARB)
                                       (SETQ V-TR2 (F-REG NIL))]
                                     [(NOT (EQ (CADDDADR V-T) V-DV))
                                       (SETQ V-DV 'ARB)])
                               (COND [(EQ (CAADR V-T) V-E)
                                       (SETQ V-J (CADDADR V-T))
                                       (GO LOOP)])
                               (RPLACD (CDR V-T) (F-LEAP (CDDR V-T)))]
                             [T (SETQ V-T (F-LEAP V-T))]>
                       <SETQ V-J (CADR S-INST)>
                  LOOP <SETQ V-T (F-EXP (CAR V-L) V-TR V-T)>
                       <SETQ V-TR V-TR2>
                       <COND [(NULL (SETQ V-L (CDR V-L))) (RETURN V-T)]>
                       <SETQ V-T (F-ADD V-T V-E V-TR V-J V-DV)>
                       <SETQ V-T (F-ADD V-T 'MINUS V-TR NIL)>
                       <GO LOOP>)])))

(CSETQ F-CC
(LAMBDA (V-L V-R V-T V-B)
        (SETQ V-T (F-ADD V-T 'CHAIN V-R (SETQ V-R (F-REG X-INDX)) V-B))
        (F-EXP (CAR V-L) V-R V-T)))

(CSETQ F-REPL
(LAMBDA (V-L V-R V-T V-B)
        (PROG <V-C V-I>
              <COND [(F-ONE (SETQ V-I (CADR V-L))) (GO ON)]
                    [(NOT (AND (SETQ V-C (*CHAIN (CAADR V-L)))
                               (F-ONE (SETQ V-I (CADADR V-L)))))
                      (RETURN NIL)]>
           ON <SETQ V-T (F-ADD V-T 'EMIT G-XV+1 I-SA V-B)>
              <COND [V-C (SETQ V-T (F-ADD V-T 'CHAIN G-XV+1 G-XV+1 V-C))
                     ]>
              <RETURN (F-EXP (CAR V-L) (F-MAKE V-R R-XV) (F-ADD V-T 'GET
               G-XV+1 (F-VBLE V-I G-XV+1)))>)))

(PUT 'COND 'X-SPF
(LAMBDA (V-L V-R V-T)
        (SETQ V-T (F-LEAP V-T))
        (F-IF V-L V-R S-INST V-T)))

(PUT 'QUOTE 'X-SPF
(LAMBDA (V-L V-R V-T)
        (F-ADD V-T 'GET V-R (CONS 'QUOTE V-L))))

(PUT 'DO 'X-SPF F-SEQ)

(PUT 'PROG 'X-SPF
(LAMBDA (V-L V-R V-T)
        (COND [(EQ (CAAR V-T) 'RETURN)
                (CSETQ S-INST (CAR V-T))
                (RPLACD V-T (F-ADD (CDR V-T) 'END NIL))]
              [T (SETQ V-T (F-LEAP (F-ADD V-T 'END T)))])
        (F-PRG (CAR V-L) W-VARS (CDR V-L) (CONS V-R S-INST) V-T)))

(PUT 'SETQ 'X-SPF
(LAMBDA (V-L V-R V-T)
        (FLAG V-R X-INDX)
        (F-EXP (CADR V-L) V-R (F-ADD V-T 'SET V-R (F-VBLE (CAR V-L) V-R)
         ))))

(PUT 'GO 'X-SPF
(LAMBDA (V-L V-R V-T)
        (SETQ V-L (CAR V-L))
        (COND [(NOT (SETQ V-R (GET W-LABS V-L)))
                (PUT W-LABS V-L (SETQ V-R (GENSYM V-L)))])
        (SETQ V-T (F-ADD V-T 'GO V-R))
        (COND [W-ATMT (F-ADD V-T 'UNTRAP)]
              [T V-T])))

(PUT 'CSETQ 'X-SPF
(LAMBDA (V-L V-R V-T)
        (F-EXP (CADR V-L) V-R (F-ADD V-T 'SET V-R (F-VBLE (FLAG (CAR V-L
         ) X-CON) V-R)))))

(PUT 'LAMBDA 'X-SPF
(LAMBDA (V-L V-R V-T)
        (F-LAMB V-L V-R NIL V-T)))

(PUT 'AND 'X-SPF
(LAMBDA (V-L V-R V-T)
        (F-AOR V-L 'AND V-R V-T)))

(PUT 'OR 'X-SPF
(LAMBDA (V-L V-R V-T)
        (F-AOR V-L 'OR V-R V-T)))

(PUT 'STACK 'X-SPF
(LAMBDA (V-L V-R V-T)
        (COND [(EQ (CAAR V-T) 'PUSH) (SETQ V-T (CDR V-T))])
        (F-EXP (CAR V-L) (F-MAKE V-R R-XV) (F-ADD V-T 'STACK))))

(PUT 'ATTEMPT 'X-SPF
(LAMBDA (V-L V-R V-T)
        (PROG <V-I V-F V-N (W-ATMT T)>
              <SETQ V-T (F-LEAP V-T)>
              <SETQ V-I S-INST>
              <SETQ V-T (F-EXP (CAR V-L) (F-MAKE V-R R-XV) (F-ADD V-T '
               UNTRAP))>
              <SETQ V-T (F-ADD V-T 'TRAP)>
              <SETQ W-ATMT F>
              <SETQ V-F (CADAR (SETQ V-T (F-LABL V-T NIL)))>
         LOOP <COND [(NULL (SETQ V-L (CDR V-L))) (GO DONE)]>
              <SETQ V-T (F-SEQ (CDAR V-L) V-R (F-ADDI V-I V-T))>
              <SETQ V-T (F-ADD V-T 'TRAPN (CAAR V-L) V-N)>
              <SETQ V-N (CADAR (SETQ V-T (F-LABL V-T NIL)))>
              <GO LOOP>
         DONE <RETURN (F-ADD V-T 'SKIP G-XV V-F)>)))

(PUT 'RETURN 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (SETQ V-T (F-ADDI (CDR W-RET) V-T))
        (COND [W-ATMT (SETQ V-T (F-ADD V-T 'UNTRAP))])
        (F-EXP (CAR V-L) (CAR W-RET) V-T)))

(PUT 'MANIFEST 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (F-ADD V-T 'GET V-R (LIST 'QUOTE (EVAL (CAR V-L))))))

(PUT '*CAR 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (F-CC V-L V-R V-T 2Q)))

(PUT '*CDR 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (F-CC V-L V-R V-T 3Q)))

(PUT 'RPLACA 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (F-REPL V-L V-R V-T '(2016000000Q))))

(PUT 'RPLACD 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (F-REPL V-L V-R V-T '(1416000000Q))))

(PUT 'CONS 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (PROG <V-C V-I>
              <COND [(F-ONE (SETQ V-I (CADR V-L))) (GO ON)]
                    [(NOT (AND (SETQ V-C (*CHAIN (CAADR V-L)))
                               (F-ONE (SETQ V-I (CADADR V-L)))))
                      (RETURN NIL)]>
           ON <SETQ V-T (F-ADD V-T 'NODE*0)>
              <COND [V-C (SETQ V-T (F-ADD V-T 'CHAIN G-XV+1 G-XV+1 V-C))
                     ]>
              <RETURN (F-EXP (CAR V-L) (F-MAKE V-R R-XV) (F-ADD V-T 'GET
               G-XV+1 (F-VBLE V-I G-XV+1)))>)))

(PUT 'NULL 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (COND [(NOT (F-TEST V-T)) NIL]
              [T (F-EXP (CAR V-L) V-R (RPLACD V-T (F-XVAL (F-SWAP (CDR
                  V-T)) V-R)))])))

(PUT 'NOT 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (COND [(NOT (F-TEST V-T)) NIL]
              [T (F-EXP (CAR V-L) V-R (RPLACD V-T (F-XVAL (F-SWAP (CDR
                  V-T)) V-R)))])))

(PUT 'EQ 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (PROG <(V-X (CAR V-L)) (V-Y (CADR V-L))>
              <COND [(NOT (F-TEST V-T)) (RETURN NIL)]
                    [(F-ONE V-Y) (GO FIX)]
                    [(NOT (F-ONE V-X)) (RETURN NIL)]>
              <SETQ V-X V-Y>
              <SETQ V-Y (CAR V-L)>
          FIX <RPLACA (CDDAR V-T) (F-VBLE V-Y V-R)>
              <RETURN (F-EXP V-X V-R (RPLACD V-T (F-XVAL (F-SWAP (CDR
               V-T)) V-R)))>)))

(PUT 'ATOM 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (COND [(NOT (F-TEST V-T)) NIL]
              [T (F-EXP (CAR V-L) (F-MAKE V-R R-XV) (F-ADD (F-XVAL (CDR
                  V-T) V-R) 'GETYPE))])))

(PUT 'IFTYPE 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (COND [(OR (NOT (F-TEST V-T))
                   (NOT (NUMBERP (CADR V-L)))) NIL]
              [T (F-EXP (CAR V-L) (F-MAKE V-R R-XV) (F-ADD (F-ADD (
                  F-XVAL (F-SWAP (CDR V-T)) V-R) 'EMIT G-XV+1 I-ANA (
                  CONS A-Q (CADR V-L))) 'GETYPE))])))

(PUT 'ZEROP 'X-SPFN
(LAMBDA (V-L V-R V-T)
        (COND [(NOT (F-TEST V-T)) NIL]
              [T (F-EXP (CAR V-L) (F-MAKE V-R R-XV) (F-ADD (F-XVAL (
                  F-SWAP (CDR V-T)) V-R) 'EMIT G-XV+1 I-LA '(16000000Q))
                  )])))

(PUT 'LAMDA 'X-SPFH
(LAMBDA (V-E)
        (LIST 'FUNCTION (CONS 'LAMBDA (CDR V-E)))))

(PUT 'DEFSPEC 'X-SPFH
(LAMBDA (V-E)
        (COND [(MINUSP (CADDR V-E))
                (LIST (CAR V-E) (LIST 'QUOTE (CDR V-E)))]
              [T (LIST 'L-DFSM (LIST 'QUOTE (CADR V-E))
                  (COND [(EQ (CAR V-E) 'DEFSPEC) 'L-SEXP]
                        [T 'L-MEXP]) (CADDR V-E))])))

(PUT 'DEFMAC 'X-SPFH
(LAMBDA (V-E)
        (COND [(MINUSP (CADDR V-E))
                (LIST (CAR V-E) (LIST 'QUOTE (CDR V-E)))]
              [T (LIST 'L-DFSM (LIST 'QUOTE (CADR V-E))
                  (COND [(EQ (CAR V-E) 'DEFSPEC) 'L-SEXP]
                        [T 'L-MEXP]) (CADDR V-E))])))

(PUT 'OBLIST 'X-SPFH
(LAMBDA (V-E)
        (PROG <V-X>
              <COND [(AND (SETQ V-X (CDR V-E))
                          (SETQ V-X (F-CHKF (CAR V-X) 4)))
                      (RETURN (LIST (CAR V-E) V-X))]
                    [T (RETURN V-E)]>)))

(PUT 'MAP 'X-SPFH
(LAMBDA (V-E)
        (PROG <V-X>
              <COND [(SETQ V-X (F-CHKF (CADDR V-E) 4))
                      (RETURN (LIST (CAR V-E) (CADR V-E) V-X))]
                    [T (RETURN V-E)]>)))

(PUT 'MAPC 'X-SPFH
(LAMBDA (V-E)
        (PROG <V-X>
              <COND [(SETQ V-X (F-CHKF (CADDR V-E) 4))
                      (RETURN (LIST (CAR V-E) (CADR V-E) V-X))]
                    [T (RETURN V-E)]>)))

(PUT 'PROP 'X-SPFH
(LAMBDA (V-E)
        (PROG <V-X>
              <COND [(SETQ V-X (F-CHKF (CADDDR V-E) 5))
                      (RETURN (LIST (CAR V-E) (CADR V-E) (CADDR V-E) V-X
                       ))]
                    [T (RETURN V-E)]>)))

(PUT 'GO 'X-OPT
(LAMBDA (V-I V-T)
        (SETQ V-T (F-CHOP V-T))
        (COND [(EQ (CADR V-I) (CADAR V-T)) V-T]
              [T (CONS V-I V-T)])))

(PUT 'RETURN 'X-OPT
(LAMBDA (V-I V-T)
        (CONS V-I (F-CHOP V-T))))

(PUT 'REPEAT 'X-OPT
(LAMBDA (V-I V-T)
        (CONS V-I (F-CHOP V-T))))

(PUT 'FALSE 'X-OPT F-TFO)

(PUT 'TRUE 'X-OPT F-TFO)

(CSETQ E-REG
(LAMBDA (V-R V-T)
        (PROG <V-V>
              <COND [(SETQ V-V (GET V-R X-REG)) (RETURN V-V)]>
              <SETQ V-V V-T>
              <COND [(IFFLAG V-R X-INDX) (GO INDEX)]
                    [V-T (GO EXIT)]>
              <CSETQ K-AREG (REMAINDER (ADD1 K-AREG) 10)>
              <SETQ V-V (PLUS K-AREG 4)>
              <GO EXIT>
        INDEX <COND [(AND V-T
                          (LESSP V-T 4)) (GO EXIT)]>
              <SETQ V-V (CSETQ K-XREG (REMAINDER (ADD1 K-XREG) 4))>
         EXIT <F-MAKE V-R V-V>
              <RETURN V-V>)))

(CSETQ E-ADDR
(LAMBDA (V-V)
        (COND [(NOT (ATOM V-V)) (LIST (CADR V-V) A-Q)]
              [(NOT (IFTYPE V-V 7)) (LIST V-V A-Q)]
              [(F-CON V-V) (E-FIX V-V A-LH)]
              [(PROG <V-L>
                     <COND [(SETQ V-L (ASSOC V-V K-BIND))
                             (RETURN
                              (COND [(IFFLAG V-V X-FLU)
                                      (E-EMIT I-LX R-XW (CDR V-L))
                                      (LIST (LOGOR R-XWS A-RH))]
                                    [T (CDR V-L)]))]>)]
              [T (E-LINK L-LOOK)
                 (LIST V-V A-Q)])))

(CSETQ E-FIX
(LAMBDA (V-V V-J)
        (COND [(LESSP 177777Q (RPLACD 0Q V-V))
                (E-EMIT I-LX R-XW (LIST V-V A-Q))
                (LIST (LOGOR R-XWS V-J))]
              [T (LIST V-V V-J)])))

(CSETQ E-EMIT
(LAMBDA (V-I V-R V-A)
        (SETQ V-R (LEFTSHIFT V-R 22))
        (COND [(ATOM V-A) (*EMIT (LIST V-I V-R) V-A)]
              [(ATOM (CDR V-A)) (*EMIT (CONS V-I (CONS V-R V-A)))]
              [T (*EMIT (CONS V-I (CONS V-R (CDR V-A))) (CAR V-A))])))

(CSETQ E-PLUG
(LAMBDA (V-I V-R V-L)
        (SETQ V-I (E-EMIT V-I V-R L-STOP))
        (CSETQ K-BACK (CONS (CONS V-L V-I) K-BACK))
        V-I))

(CSETQ E-LINK
(LAMBDA (V-A)
        (CSETQ K-REGS NIL)
        (E-EMIT I-LMJ R-XL V-A)))

(CSETQ E-SAVE
(LAMBDA NIL
        (CSETQ K-SAVE (LIST K-STAK K-CSTK K-PROG K-UNDO K-BIND K-NAME
         K-ARGS K-SAVE))
        (CSETQ K-REGS NIL)
        (CSETQ K-UNDO 0)))

(CSETQ E-HAVE
(LAMBDA (V-E)
        (COND [(SETQ V-E (ASSOC V-E K-REGS)) (CDR V-E)])))

(CSETQ E-NOTE
(LAMBDA (V-R V-E)
        (CSETQ K-REGS (CONS (CONS V-E V-R) K-REGS))
        V-R))

(CSETQ E-LOSE
(LAMBDA (V-R)
        (CSETQ K-REGS (E-DROP K-REGS V-R))
        V-R))

(CSETQ E-DROP
(LAMBDA (V-L V-R)
        (COND [(NULL V-L) NIL]
              [(EQUAL (CDAR V-L) V-R) (E-DROP (CDR V-L) V-R)]
              [T (RPLACD V-L (E-DROP (CDR V-L) V-R))])))

(PUT 'GET 'X-EMIT
(LAMBDA (V-R V-V)
        (PROG <(V-T (E-HAVE V-V))>
              <COND [(EQUAL V-T (SETQ V-R (E-REG V-R V-T))) (RETURN T)]
                    [T (E-EMIT I-LMA V-R (E-ADDR V-V))]>
              <E-NOTE (E-LOSE V-R) V-V>)))

(PUT 'SET 'X-EMIT
(LAMBDA (V-R V-V)
        (PROG <V-T>
              <E-EMIT I-SA V-R (E-ADDR V-V)>
         LOOP <COND [(SETQ V-T (E-HAVE V-V))
                      (E-LOSE V-T)
                      (GO LOOP)]>
              <E-NOTE V-R V-V>)))

(PUT 'PUSH 'X-EMIT
(LAMBDA (V-R)
        (E-EMIT I-SA V-R A-STP)
        (CSETQ K-STAK (SUB1 K-STAK))))

(PUT 'MARK 'X-EMIT
(LAMBDA NIL
        (E-EMIT I-SX R-XT A-CSTP)
        (CSETQ K-CSTK (CONS K-STAK K-CSTK))))

(PUT 'CALL 'X-EMIT
(LAMBDA (V-R)
        (CSETQ K-STAK (CAR K-CSTK))
        (CSETQ K-CSTK (CDR K-CSTK))
        (COND [(EQ (CAAR K-CODE) 'PUSH)
                (E-LINK L-CALP)
                (CSETQ K-CODE (CDR K-CODE))
                (CSETQ K-STAK (SUB1 K-STAK))]
              [(EQ (CAAR K-CODE) 'RETURN)
                (E-EMIT I-J 0 L-CALLI)
                (CSETQ K-CODE (CDR K-CODE))
                (CSETQ K-REGS NIL)]
              [T (E-LINK L-CALL)])))

(PUT 'MINUS 'X-EMIT
(LAMBDA (V-R V-V)
        (E-LOSE (ADD1 V-R))
        (E-EMIT I-ANU V-R (E-ADDR V-V))))

(PUT 'TRUE 'X-EMIT
(LAMBDA (V-R V-L V-DV)
        (E-PLUG I-JNZ (ADD1 V-R) V-L)))

(PUT 'FALSE 'X-EMIT
(LAMBDA (V-R V-L V-DV)
        (E-PLUG I-JZ (ADD1 V-R) V-L)))

(PUT 'GO 'X-EMIT
(LAMBDA (V-L)
        (E-PLUG I-J 0 V-L)))

(PUT 'SKIP 'X-EMIT
(LAMBDA (V-R V-L)
        (E-LOSE V-R)
        (SETQ V-R (PLUS V-R 12))
        (E-EMIT I-SZ 0 (CONS 0 V-R))
        (E-PLUG I-LMJ V-R V-L)))

(PUT 'RETURN 'X-EMIT
(LAMBDA (V-L)
        (E-EMIT I-J 0 L-EXIT)))

(PUT 'BIND 'X-EMIT
(LAMBDA (V-V)
        (PROG NIL
              <COND [(NOT K-PROG)
                      (CSETQ K-STAK (CSETQ K-ARGS (SUB1 K-STAK)))]>
              <COND [(NOT (IFFLAG V-V X-FLU)) (GO NORMAL)]
                    [(NOT K-PROG)
                      (E-EMIT I-LMA R-XV (CONS A-STAK K-STAK))]>
              <E-EMIT I-LMA R-XV+1 (LIST V-V A-Q)>
              <E-LINK L-BIND>
              <CSETQ K-UNDO (ADD1 K-UNDO)>
              <E-EMIT I-SA R-XV (CONS A-STAK K-STAK)>
       NORMAL <CSETQ K-BIND (CONS (CONS V-V (CONS A-STAK K-STAK)) K-BIND
               )>)))

(PUT 'LABEL 'X-EMIT
(LAMBDA (V-L)
        (PROG <V-A>
              <SETQ V-A (*ORG (E-EMIT I-J 0 L-STOP))>
              <PUT V-L X-LAB V-A>
              <CSETQ K-REGS NIL>)))

(PUT 'ENTRY 'X-EMIT
(LAMBDA (V-F)
        (E-SAVE)
        (CSETQ K-BIND
         (COND [V-F (CSETQ K-ARGS V-F)
                    (INTO K-BIND
                     (LAMBDA (V-V)
                             (CONS (CAR V-V) (CONS (CADR V-V) (PLUS (
                              DIFFERENCE (CDDR V-V) (CAR K-CSTK)) K-ARGS
                              )))))]))
        (CSETQ K-STAK (CSETQ K-ARGS 0))
        (CSETQ K-CSTK (CSETQ K-PROG NIL))
        (CSETQ K-NAME (*ORG (E-EMIT I-J 0 L-STOP)))))

(PUT 'REPEAT 'X-EMIT
(LAMBDA NIL
        (COND [(NOT (EQUAL K-STAK K-ARGS))
                (E-EMIT I-LXM R-XT (LIST (LOGOR A-Q R-XTS (DIFFERENCE
                 K-ARGS K-STAK))))])
        (E-EMIT I-J 0 K-NAME)))

(PUT 'BEGIN 'X-EMIT
(LAMBDA NIL
        (E-SAVE)
        (CSETQ K-PROG T)))

(PUT 'END 'X-EMIT
(LAMBDA (V-F)
        (COND [(AND V-F
                    (NOT (EQUAL (CAR K-SAVE) K-STAK)))
                (E-EMIT I-LXM R-XT (LIST (LOGOR A-Q R-XTS (DIFFERENCE (
                 CAR K-SAVE) K-STAK))))])
        (COND [(AND V-F
                    (NOT (ZEROP K-UNDO)))
                (E-EMIT I-LMA R-XV+1 (CONS A-Q K-UNDO))
                (E-LINK L-UB)])
        (CSETQ K-REGS NIL)
        (CSETQ K-STAK (CAR K-SAVE))
        (CSETQ K-CSTK (CADR K-SAVE))
        (CSETQ K-PROG (CADDR K-SAVE))
        (CSETQ K-UNDO (CADDDR K-SAVE))
        (CSETQ K-BIND (CADDDDR K-SAVE))
        (CSETQ K-NAME (CADDDDDR K-SAVE))
        (CSETQ K-ARGS (CADDDDDDR K-SAVE))
        (CSETQ K-SAVE (CADDDDDDDR K-SAVE))))

(PUT 'STACK 'X-EMIT
(LAMBDA NIL
        (E-LINK L-STAK)))

(PUT 'LIST 'X-EMIT
(LAMBDA NIL
        (CSETQ K-PROG T)
        (E-EMIT I-LA R-XY (CONS 0 R-XF))
        (COND [(NOT (ZEROP K-STAK))
                (E-EMIT I-ANA R-XY (CONS A-Q (MINUS K-STAK)))])
        (E-LINK L-LIST)))

(PUT 'CHAIN 'X-EMIT
(LAMBDA (V-R V-SR V-B)
        (PROG <V-X V-F V-L>
              <SETQ V-SR (E-REG V-SR NIL)>
              <COND [(GREATERP V-B 1) (GO NORMAL)]
                    [(SETQ V-X (GET V-R X-REG))
                      (E-EMIT I-LMA V-X (LIST V-SR))]
                    [T (F-MAKE V-R V-SR)]>
              <RETURN NIL>
       NORMAL <SETQ V-X
               (COND [(ZEROP (LOGAND V-B 1)) A-LH]
                     [T A-RH])>
              <COND [(SETQ V-F (LESSP (SETQ V-B (QUOTIENT V-B 2)) 2))
                      (SETQ V-L (E-REG V-R NIL))]
                    [T (SETQ V-L V-SR)]>
              <E-EMIT I-LMA V-L (LIST (LOGOR V-X (LEFTSHIFT (PLUS V-SR
               12) 18)))>
              <E-LOSE V-L>
              <COND [(NOT V-F) (GO NORMAL)]>)))

(PUT 'EMIT 'X-EMIT
(LAMBDA (V-R V-I V-A)
        (CSETQ K-REGS NIL)
        (E-EMIT V-I V-R V-A)))

(PUT 'GETYPE 'X-EMIT
(LAMBDA NIL
        (E-LINK L-GTYP)))

(PUT 'NODE*0 'X-EMIT
(LAMBDA NIL
        (E-LINK L-NOD0)))

(PUT 'TRAP 'X-EMIT
(LAMBDA NIL
        (E-LINK L-TRAP)
        (CSETQ K-CSTK (CONS K-STAK K-CSTK))
        (CSETQ K-STAK (SUB1 K-STAK))))

(PUT 'UNTRAP 'X-EMIT
(LAMBDA NIL
        (E-LINK L-UT)
        (CSETQ K-STAK (CAR K-CSTK))
        (CSETQ K-CSTK (CDR K-CSTK))))

(PUT 'TRAPN 'X-EMIT
(LAMBDA (V-N V-L)
        (CSETQ K-REGS NIL)
        (SETQ V-N (LOGAND (LEFTSHIFT V-N 18) 777777000000Q))
        (COND [V-L (E-PLUG V-N 0 V-L)]
              [T (E-EMIT V-N 0 '(0))])))

(FLAG 'SET 'X-ASG)
(FLAG 'PUSH 'X-ASG)
(FLAG 'MINUS 'X-ASG)
(FLAG 'TRUE 'X-ASG)
(FLAG 'FALSE 'X-ASG)
(FLAG 'SKIP 'X-ASG)
(FLAG 'EMIT 'X-ASG)
(FLAG 'SET 'X-DONT)
(FLAG 'SETQ 'X-DONT)
(FLAG 'PROG 'X-DONT)
(FLAG 'LAMBDA 'X-DONT)
(FLAG 'LAMDA 'X-DONT)
(FLAG 'GO 'X-DONT)
(FLAG 'RETURN 'X-DONT)
(FLAG 'STACK 'X-DONT)
(PUT 'GO 'X-LEAP 'GO)
(PUT 'RETURN 'X-LEAP 'RETURN)
(PUT 'LABEL 'X-LEAP 'GO)
(CSETQ X-SPF 'X-SPF)
(CSETQ X-SPFN 'X-SPFN)
(CSETQ X-SPFH 'X-SPFH)
(CSETQ X-FLU 'X-FLU)
(CSETQ X-CON 'X-CON)
(CSETQ X-LEAP 'X-LEAP)
(CSETQ X-REG 'X-REG)
(CSETQ X-INDX 'X-INDX)
(CSETQ X-OPT 'X-OPT)
(CSETQ X-EMIT 'X-EMIT)
(CSETQ X-ASG 'X-ASG)
(CSETQ X-LAB 'X-LAB)
(CSETQ X-DONT 'X-DONT)
(CSETQ G-XV 'XV)
(CSETQ G-XV+1 'XV+1)
(CSETQ K-FREE 'NIL)
(CSETQ K-STAK 'NIL)
(CSETQ K-CSTK 'NIL)
(CSETQ K-PROG 'NIL)
(CSETQ K-UNDO 'NIL)
(CSETQ K-BIND 'NIL)
(CSETQ K-BACK 'NIL)
(CSETQ K-SAVE 'NIL)
(CSETQ K-CODE 'NIL)
(CSETQ K-NAME 'NIL)
(CSETQ K-ARGS 'NIL)
(CSETQ K-REGS 'NIL)
(CSETQ G-EXIT 'EXIT)
(CSETQ K-AREG 0)
(CSETQ K-XREG 2)
(CSETQ I-LMA 120000000000Q)
(CSETQ I-SA 10000000000Q)
(CSETQ I-SX 60000000000Q)
(CSETQ I-ANU 210000000000Q)
(CSETQ I-LX 270000000000Q)
(CSETQ I-LXM 260000000000Q)
(CSETQ I-LA 100000000000Q)
(CSETQ I-ANA 150000000000Q)
(CSETQ I-AX 240000000000Q)
(CSETQ I-SZ 50000000000Q)
(CSETQ I-JNZ 740400000000Q)
(CSETQ I-JZ 740000000000Q)
(CSETQ I-J 742000000000Q)
(CSETQ I-LMJ 745400000000Q)
(CSETQ L-CALP (*EPT 2))
(CSETQ L-CALP (*EPT 2))
(CSETQ L-CALL (*EPT 3))
(CSETQ L-EXIT (*EPT 4))
(CSETQ L-LIST (*EPT 5))
(CSETQ L-STOP (*EPT 7))
(CSETQ L-LOOK (*EPT 8))
(CSETQ L-BIND (*EPT 9))
(CSETQ L-NOD0 (*EPT 10)
(CSETQ L-MEXP (*EPT 14)
(CSETQ L-UB (*EPT 16))
(CSETQ L-GTYP (*EPT 17))
(CSETQ L-STAK (*EPT 18))
(CSETQ L-SEXP (*EPT 19))
(CSETQ L-TRAP (*EPT 23))
(CSETQ L-CALLI (*EPT 29))
(CSETQ S-INST 'NIL)
(CSETQ L-UT (*EPT 24))
(CSETQ L-DFSM (*EPT 27))
(PUT 'EXIT 'X-LAB L-EXIT)
(CSETQ R-XV 2)
(CSETQ R-XV+1 3)
(PUT 'XV 'X-REG 2)
(PUT 'XV+1 'X-REG 3)
(CSETQ R-XT 1)
(CSETQ R-XTS 1000000Q)
(CSETQ R-XL 4)
(CSETQ R-XY 1)
(CSETQ R-XF 2)
(CSETQ R-XW 10Q)
(CSETQ R-XWS 10000000Q)
(CSETQ A-STP '(1440000Q))
(CSETQ A-CSTP '(3440000Q))
(CSETQ A-STAK 2040000Q)
(CSETQ A-Q 7000000000Q)
(CSETQ A-LH 2000000000Q)
(CSETQ A-RH 1400000000Q)

(CSETQ CM-DUMP '(COMPILE CM-PILE CM-LIST CM-EMIT EXCISE FLUID UNFLUID
         F-EXP F-SPLAMB F-LAMB F-FUNC F-LAM F-PRG F-IF F-SEQ F-PUSH
         F-CHKF F-ITER F-NICE F-ALL F-MAKE F-LEAP F-LABL F-TEST F-VBLE
         F-ADD F-ADDI F-REG F-CON F-ONE F-SWAP F-XVAL F-CHOP F-TFO
         F-LIKE F-AOR F-CC F-REPL (X-SPF COND QUOTE DO PROG SETQ GO
         CSETQ LAMBDA AND OR STACK ATTEMPT) (X-SPFN RETURN MANIFEST *CAR
         *CDR RPLACA RPLACD CONS NULL NOT EQ ATOM IFTYPE ZEROP) (X-SPFH
         LAMDA DEFSPEC DEFMAC OBLIST MAP MAPC PROP) (X-OPT GO RETURN
         REPEAT FALSE TRUE) E-REG E-ADDR E-FIX E-EMIT E-PLUG E-LINK
         E-SAVE E-HAVE E-NOTE E-LOSE E-DROP (X-EMIT GET SET PUSH MARK
         CALL MINUS TRUE FALSE GO SKIP RETURN BIND LABEL ENTRY REPEAT
         BEGIN END STACK LIST CHAIN EMIT GETYPE NODE*0 TRAP UNTRAP TRAPN
         ) (X-ASG SET PUSH MINUS TRUE FALSE SKIP EMIT) (X-DONT SET SETQ
         PROG LAMBDA LAMDA GO RETURN STACK) (X-LEAP GO RETURN LABEL)
         X-SPF X-SPFN X-SPFH X-FLU X-CON X-LEAP X-REG X-INDX X-OPT
         X-EMIT X-ASG X-LAB X-DONT G-XV G-XV+1 K-FREE K-STAK K-CSTK
         K-PROG K-UNDO K-BIND K-BACK K-SAVE K-CODE K-NAME K-ARGS K-REGS
         G-EXIT K-AREG K-XREG I-LMA I-SA I-SX I-ANU I-LX I-LXM I-LA
         I-ANA I-AX I-SZ I-JNZ I-JZ I-J I-LMJ L-CALP L-CALL L-EXIT
         L-LIST L-STOP L-LOOK L-BIND L-NOD0 L-MEXP L-UB L-GTYP L-STAK
         L-SEXP L-TRAP L-CALLI S-INST L-UT L-DFSM (X-LAB EXIT) R-XV
         R-XV+1 (X-REG XV XV+1) R-XT R-XTS R-XL R-XY R-XF R-XW R-XWS
         A-STP A-CSTP A-STAK A-Q A-LH A-RH CM-DUMP))

"COMPILER LOADED"