(rplacd conlook ((expr lambda (x) (sadd conorg (locate (setq x (
eva x)) (cond ((locate x contab) contab) (t (setq contab (nconc 
contab (list x)))))))))) 
(rplacd psym ((apval (sft.-117777) (iot.-57777) (opr.-17777) (sk
p.-137777) (law.-77777) (jsp.-157777) (div.-217777) (mul.-237777
) (isp.-317777) (idx.-337777) (dzm.340000) (dap.260000) (dip.300
000) (jda.170000) (xor.60000) (ior.40000) (and.20000) (xct.10000
0) (i.10000) (lac.200000) (dac.240000) (jmp.-177777) (add.-37777
7) (lio.220000) (dio.320000) (sub.-357777) (cal.160000) (sad.-27
7777) (sas.-257777)))) 
(rplacd work ((expr lambda (x) (cond ((atom x) (desym x loc)) ((
assoc (car x) mac nil) (map ((lambda (y) (mcall (cdr x) (car y) 
(cdr y))) (assoc (car x) mac nil)) (quote work))) ((member (car 
x) psi) ((car x) (cdr x))) ((and (atom (cdr x)) (cdr x)) (desym 
(car x) (cdr x))) (t (prog2 (cond (pass (pass2 x)) (t nil)) (set
q loc (add1 loc)))))))) 
(rplacd sadd ((expr lambda (x y) (cond ((numberp x) (cond ((numb
erp y) (plus x y)) (t y))) (t x))))) 
(rplacd org ((expr lambda (x) (cond ((setq loc (eva x)) nil) (t 
(error (cons (quote org) x))))))) 
(rplacd fixtab ((expr lambda (x) (csetq psym sym)))) 
(rplacd macro ((expr lambda (x) (rplacd (sassoc (car x) mac (fun
c nil (car (setq mac (cons (list (car x)) mac))))) (cdr x))))) 
(rplacd mcall ((expr lambda (x y z) (cond ((null y) z) ((null x)
 (mcall (list nil) y z)) (t (mcall (cdr x) (cdr y) (subst (car x
) (car y) z))))))) 
(rplacd pass2 ((expr lambda (x) (cond ((eva x) (output (eva x) l
oc)) (t (error (list loc x (quote undefined)))))))) 
(rplacd desym ((expr lambda (x y) (rplacd (sassoc x sym (func ni
l (car (setq sym (cons (list x) sym))))) y)))) 
(rplacd eva ((expr lambda (x) (cond ((null x) 0) ((numberp (car 
x)) (sadd (car x) (eva (cdr x)))) ((atom (car x)) (sadd (assoc (
car x) sym nil) (eva (cdr x)))) (t (sadd (conlook (car x)) (eva 
(cdr x)))))))) 
(rplacd stoflag ((apval))) 
(rplacd lap ((expr lambda (l x) (prog (sym conorg contab pass ma
c loc) (setq sym psym) (setq loc l) (map x (quote work)) (setq c
onorg loc) (setq loc l) (setq pass t) (map x (quote work)) (map 
contab (func (x) (work (list x)))) (map sym (func (z) (sassoc (c
ar z) psym (func nil (print z))))) (return loc))))) 
(rplacd locate ((expr lambda (x y) (prog (n) (setq n 0) a (cond 
((null y) (return nil)) ((equal x (car y)) (return n))) (setq n 
(add1 n)) (setq y (cdr y)) (go a))))) 
(rplacd entry ((expr lambda (x) (prog nil (desym (car x) loc) (r
placd (car x) (list (cons (cadr x) (plus -177777 loc)))) (cond (
(null pass) (print (cons (quote entry) (cons loc x))))))))) 
(rplacd output ((expr lambda (w l) (cond (stoflag (xeq (plus 240
000 l) w 0)) (t (prog nil (prin1 .
) (prin1 l) (prin1 ./) (prin1 .	) (prin1 w))))))) 
(rplacd psi ((apval macro org fixtab entry irp repeat ifdo))) 
(rplacd irp ((expr lambda (w) (map (cadr w) (func (s) (map (subs
t s (car w) (cddr w)) (quote work))))))) 
(rplacd ifdo ((expr lambda (x) (cond ((eval (car x) sym) (map (c
dr x) (quote work))) (t nil))))) 
(rplacd repeat ((expr lambda (x) (prog (n) (setq n (eval (car x)
 sym)) a (cond ((greaterp 1 n) (return nil))) (map (cdr x) (quot
e work)) (setq n (sub1 n)) (go a))))) 
(rplacd dumpl ((expr lambda (n) (dump n (quote (conlook psym wor
k sadd org fixtab macro mcall pass2 desym eva stoflag lap locate
 entry output psi irp ifdo repeat dumpl)))))) 
(stop 15)                      
                                                >>76<<