diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index 81cabc4..979866d 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -2263,6 +2263,183 @@ nothing (see boot2Lisp) yet still allow function call (lisp2BootAndComp).
 
 @
 
+\defun{def-message}{def-message}
+\calls{def-message}{def-message1}
+<<defun def-message>>=
+(defun def-message (u)
+ (cons (first u) (mapcar #'def-message1 (cdr u))))
+
+@
+
+\defun{def-message1}{def-message1}
+\calls{def-message1}{eqcar}
+\calls{def-message1}{def-message1}
+\calls{def-message1}{deftran}
+<<defun def-message1>>=
+(defun def-message1 (v)
+ (cond
+  ((and (stringp v) (> (size v) 0) (not (eq (elt v 0) '\%)))
+   (list 'makestring v))
+  ((eqcar v 'cons)
+   (list 'cons (def-message1 (second v)) (def-message1 (third v))))
+  ((deftran v))))
+
+@
+
+\defun{def-in2on}{def-in2on}
+\calls{def-in2on}{eqcar}
+<<defun def-in2on>>=
+(defun def-in2on (it)
+ (mapcar 
+  #'(lambda (x) (let (u)
+     (cond
+      ((and (eqcar x 'in) (eqcar (third x) '|tails|))
+       (list 'on (second x) (second (third x))))
+      ((and (eqcar x 'in) (eqcar (setq u (third x)) 'segment))
+       (cond
+        ((third u) (list 'step (second x) (second u) 1 (third u)))
+        ((list 'step (second x) (second u) 1))))
+      ((and (eqcar x 'inby) (eqcar (setq u (third x)) 'segment))
+       (cond
+        ((third u) (list 'step (second x) (second u) (|last| x) (third u)))
+        ((list 'step (second x) (second u) (|last| x)))))
+      (x))))
+    it))
+
+@
+
+\defun{def-cond}{def-cond}
+\calls{def-cond}{deftran}
+\calls{def-cond}{def-cond}
+<<defun def-cond>>=
+(defun def-cond (l)
+ (cond
+  ((not l) nil)
+  ((cons (mapcar #'deftran (first l)) (def-cond (cdr l))))))
+
+@
+
+\defdollar{is-spill}
+<<initvars>>=
+(defvar $is-spill nil)
+
+@
+
+\defdollar{is-spill-list}
+<<initvars>>=
+(defvar $is-spill-list nil)
+
+@
+
+\defun{def-is-eqlist}{def-is-eqlist}
+\calls{def-is-eqlist}{}
+\usesdollar{def-is-eqlist}{is-eqlist}
+\usesdollar{def-is-eqlist}{is-spill-list}
+<<defun def-is-eqlist>>=
+(defun def-is-eqlist (str)
+ (let (g e)
+  (declare (special $is-eqlist $is-spill-list))
+  (cond
+   ((not str) (push `(eq ,(setq g (is-gensym)) nil) $is-eqlist) g)
+   ((eq str '\.) (is-gensym))
+   ((identp str) str)
+   ((stringp str)
+     (setq e (def-string str))
+     (push (list (if (atom (second e)) 'eq 'equal)
+                 (setq g (is-gensym)) e)
+        $is-eqlist)
+     g)
+   ((or (numberp str) (member str '((|Zero|) (|One|))))
+    (push (list 'eq (setq g (is-gensym)) str) $is-eqlist)
+    g)
+   ((atom str) (errhuh))
+   ((eqcar str 'spadlet)
+    (cond
+     ((identp (second str))
+      (push (def-is2 (second str) (third str)) $is-spill-list)
+      (second str))
+     ((identp (third str))
+       (push (deftran str) $is-spill-list) (third str))
+     ((errhuh))))
+   ((eqcar str 'quote)
+    (push (list (cond ((atom (second str)) 'eq) ('equal))
+                (setq g (is-gensym)) str) 
+          $is-eqlist) 
+     g)
+   ((eqcar str 'list) (def-is-eqlist (list2cons str)))
+   ((or (eqcar str 'cons) (eqcar str 'vcons))
+     (cons (def-is-eqlist (second str)) (def-is-eqlist (third str))))
+   ((eqcar str 'append)
+     (unless (identp (second str)) (error "CANT!"))
+     (push (def-is2 (list 'reverse (setq g (is-gensym)))
+                    (def-is-rev (third str) (second str)))
+       $is-eqlist)
+     (cond ((eq (second str) '\.) ''t)
+      ((push (subst (second str) 'l '(or (setq l (nreverse l)) t))
+         $is-spill-list)))
+     g)
+   ((errhuh)))))
+
+@
+
+\defdollar{vl}
+<<initvars>>=
+(defparameter $vl nil)
+
+@
+
+\defun{def-is-remdup}{def-is-remdup}
+\calls{def-is-remdup}{def-is-remdup1}
+\usesdollar{def-is-remdup}{vl}
+<<defun def-is-remdup>>=
+(defun def-is-remdup (x)
+ (let ($vl)
+  (def-is-remdup1 x)))
+
+@
+
+\defun{def-is-remdup1}{def-is-remdup1}
+\calls{def-is-remdup1}{is-gensym}
+\calls{def-is-remdup1}{eqcar}
+\calls{def-is-remdup1}{def-is-remdup1}
+\calls{def-is-remdup1}{errhuh}
+\usesdollar{def-is-remdup1}{vl}
+\usesdollar{def-is-remdup1}{is-eqlist}
+<<defun def-is-remdup1>>=
+(defun def-is-remdup1 (x)
+ (let (rhs lhs g)
+ (declare (special $vl $is-eqlist))
+  (cond
+   ((not x) nil)
+   ((eq x '\.) x)
+   ((identp x)
+    (cond
+     ((member x $vl)
+      (push (list 'equal (setq g (is-gensym)) x) $is-eqlist)
+      g)
+     ((push x $vl)
+      x)))
+   ((member x '((|Zero|) (|One|))) x)
+   ((atom x) x)
+   ((eqcar x 'spadlet)
+     (setq rhs (def-is-remdup1 (third x)))
+     (setq lhs (def-is-remdup1 (second x)))
+     (list 'spadlet lhs rhs))
+   ((eqcar x 'let)
+     (setq rhs (def-is-remdup1 (third x)))
+     (setq lhs (def-is-remdup1 (second x)))
+     (list 'let lhs rhs))
+   ((eqcar x 'quote) x)
+   ((and (eqcar x 'equal) (not (cddr x)))
+     (push (list 'equal (setq g (is-gensym)) (second x)) $is-eqlist)
+     g)
+   ((member (first x) '(list append cons vcons))
+    (cons
+     (cond ((eq (first x) 'vcons) 'cons) ( (first x)))
+     (mapcar #'def-is-remdup1 (cdr x))))
+   ((errhuh)))))
+
+@
 
 \defun{addCARorCDR}{addCARorCDR}
 \calls{addCARorCDR}{eqcar}
@@ -2323,12 +2500,6 @@ nothing (see boot2Lisp) yet still allow function call (lisp2BootAndComp).
 
 @
 
-\defdollar{is-spill-list}
-<<initvars>>=
-(defparameter $is-spill-list nil)
-
-@
-
 \defun{def-is2}{def-is2}
 \calls{def-is2}{eqcar}
 \calls{def-is2}{moan}
@@ -7507,13 +7678,18 @@ if \verb|$InteractiveMode| then use a null outputstream
 <<defun def>>
 <<defun def-addlet>>
 <<defun def-collect>>
+<<defun def-cond>>
 <<defun def-inner>>
 <<defun def-insert-let>>
+<<defun def-in2on>>
 <<defun def-is>>
 <<defun def-is2>>
+<<defun def-is-eqlist>>
 <<defun defIS>>
 <<defun defIS1>>
 <<defun defISReverse>>
+<<defun def-is-remdup>>
+<<defun def-is-remdup1>>
 <<defun def-is-rev>>
 <<defun def-it>>
 <<defun def-let>>
@@ -7521,6 +7697,8 @@ if \verb|$InteractiveMode| then use a null outputstream
 <<defun defLET1>>
 <<defun defLET2>>
 <<defun defLetForm>>
+<<defun def-message>>
+<<defun def-message1>>
 <<defun def-process>>
 <<defun def-rename>>
 <<defun def-rename1>>
diff --git a/changelog b/changelog
index a574196..3fed53a 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,6 @@
+20101017 tpd src/axiom-website/patches.html 20101017.02.tpd.patch
+20101017 tpd src/interp/parsing.lisp treeshake compiler
+20101017 tpd books/bookvol9 treeshake compiler
 20101017 tpd src/axiom-website/patches.html 20101017.01.tpd.patch
 20101017 tpd src/interp/vmlisp.lisp rename some fnewmeta variables
 20101017 tpd src/interp/parsing.lisp move meta code into bookvol9
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 0b84fcd..4a2c26e 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3228,5 +3228,7 @@ books/bookvol9 treeshake compiler<br/>
 books/bookvol9 treeshake compiler<br/>
 <a href="patches/20101017.01.tpd.patch">20101017.01.tpd.patch</a>
 books/bookvol9 merge and remove fnewmeta<br/>
+<a href="patches/20101017.02.tpd.patch">20101017.02.tpd.patch</a>
+books/bookvol9 treeshake compiler<br/>
  </body>
 </html>
diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet
index b5066f4..ba0d720 100644
--- a/src/interp/parsing.lisp.pamphlet
+++ b/src/interp/parsing.lisp.pamphlet
@@ -1298,15 +1298,6 @@ foo defined inside of fum gets renamed as fum,foo.")
 
 (defun DEF-SEQ (U) (SEQOPT (CONS 'SEQ U)))
 
-(defun DEF-MESSAGE (U) (CONS (FIRST U) (mapcar #'def-message1 (cdr u))))
-
-(defun DEF-MESSAGE1 (V)
-  (COND ((AND (STRINGP V) (> (SIZE V) 0) (NOT (EQ (ELT V 0) '\%)))
-         (LIST 'MAKESTRING V))
-        ((EQCAR V 'CONS) (LIST 'CONS (DEF-MESSAGE1 (SECOND V))
-                               (DEF-MESSAGE1 (THIRD V))))
-        ((DEFTRAN V))))
-
 (defun |DEF-:| (X &aux Y)
        (DCQ (x y) x)
        `(SPADLET ,(if (or (eq y '|fluid|)
@@ -1340,26 +1331,6 @@ foo defined inside of fum gets renamed as fum,foo.")
                  (DEF-select2 X (CDR Y))))
           ((MOAN (format nil "Unexpected CASE clause: ~S" (FIRST Y)))))))
 
-(defun DEF-IN2ON (IT)
-  (mapcar #'(lambda (x) (let (u)
-              (COND
-                ((AND (EQCAR X 'IN) (EQCAR (THIRD X) '|tails|))
-                 (LIST 'ON (SECOND X) (SECOND (THIRD X))))
-                ((AND (EQCAR X 'IN) (EQCAR (setq U (THIRD X)) 'SEGMENT))
-                 (COND
-                   ((THIRD U) (LIST 'STEP (SECOND X) (SECOND U) 1 (THIRD U)))
-                   ((LIST 'STEP (SECOND X) (SECOND U) 1))  ))
-                ((AND (EQCAR X 'INBY) (EQCAR (setq U (THIRD X)) 'SEGMENT))
-                 (COND
-                   ((THIRD U) (LIST 'STEP (SECOND X) (SECOND U) (|last| x) (THIRD U)))
-                   ((LIST 'STEP (SECOND X) (SECOND U) (|last| x)))  ))
-                (X))))
-          IT))
-
-(defun DEF-COND (L)
-  (COND ((NOT L) NIL)
-        ((CONS (MAPCAR #'DEFTRAN (FIRST L)) (DEF-COND (CDR L))))))
-
 (defun MK_LEFORM (U)
   (COND ((IDENTP U) (PNAME U))
         ((STRINGP U) U)
@@ -1389,77 +1360,6 @@ foo defined inside of fum gets renamed as fum,foo.")
   (if (NOT (CDR $IS-GENSYMLIST)) (RPLACD $IS-GENSYMLIST (LIST (GENSYM))))
   (pop $IS-GENSYMLIST))
 
-(defun DEF-IS-EQLIST (STR)
-  (let (g e)
-    (COND ((NOT STR) (PUSH `(EQ ,(setq G (IS-GENSYM)) NIL) $IS-EQLIST) G)
-          ((EQ STR '\.) (IS-GENSYM))
-          ((IDENTP STR) STR)
-          ((STRINGP STR)
-           (setq E (DEF-STRING STR))
-           (PUSH (LIST (if (ATOM (SECOND E)) 'EQ 'EQUAL)
-                       (setq G (IS-GENSYM)) E)
-                 $IS-EQLIST)
-           G)
-          ((OR (NUMBERP STR) (MEMBER STR '((|Zero|) (|One|))))
-           (PUSH (LIST 'EQ (setq G (IS-GENSYM)) STR) $IS-EQLIST)
-           G)
-          ((ATOM STR) (ERRHUH))
-          ((EQCAR STR 'SPADLET)
-           (COND ((IDENTP (SECOND STR))
-                  (PUSH (DEF-IS2 (cadr str) (caddr STR)) $IS-SPILL_LIST)
-                  (SECOND STR))
-                 ((IDENTP (THIRD STR))
-                  (PUSH (DEFTRAN STR) $IS-SPILL_LIST) (THIRD STR))
-                 ((ERRHUH)) ))
-          ((EQCAR STR 'QUOTE)
-           (PUSH (LIST (COND ((ATOM (SECOND STR)) 'EQ)
-                             ('EQUAL))
-                       (setq G (IS-GENSYM)) STR) $IS-EQLIST) G)
-          ((EQCAR STR 'LIST) (DEF-IS-EQLIST (LIST2CONS STR)))
-          ((OR (EQCAR STR 'CONS) (EQCAR STR 'VCONS))
-           (CONS (DEF-IS-EQLIST (SECOND STR)) (DEF-IS-EQLIST (THIRD STR))))
-          ((EQCAR STR 'APPEND)
-           (if (NOT (IDENTP (SECOND STR))) (ERROR "CANT!"))
-           (PUSH (DEF-IS2 (LIST 'REVERSE (setq G (IS-GENSYM)))
-                          (DEF-IS-REV (THIRD STR) (SECOND STR)))
-                 $IS-EQLIST)
-           (COND ((EQ (SECOND STR) '\.) ''T)
-                 ((PUSH (SUBST (SECOND STR) 'L '(OR (setq L (NREVERSE L)) T))
-
-                        $IS-SPILL_LIST)))
-           G)
-          ((ERRHUH)))))
-
-(defparameter $vl nil)
-
-(defun def-is-remdup (x) (let ($vl) (def-is-remdup1 x)))
-
-(defun def-is-remdup1 (x)
-  (let (rhs lhs g)
-    (COND ((NOT X) NIL)
-          ((EQ X '\.) X)
-          ((IDENTP X)
-           (COND ((MEMBER X $VL)
-                  (PUSH (LIST 'EQUAL (setq G (IS-GENSYM)) X) $IS-EQLIST) G)
-                 ((PUSH X $VL) X)))
-          ((MEMBER X '((|Zero|) (|One|))) X)
-          ((ATOM X) X)
-          ((EQCAR X 'SPADLET)
-           (setq RHS (DEF-IS-REMDUP1 (THIRD X)))
-           (setq LHS (DEF-IS-REMDUP1 (SECOND X)))
-           (LIST 'SPADLET LHS RHS))
-          ((EQCAR X 'LET)
-           (setq RHS (DEF-IS-REMDUP1 (THIRD X)))
-           (setq LHS (DEF-IS-REMDUP1 (SECOND X)))
-           (LIST 'LET LHS RHS))
-          ((EQCAR X 'QUOTE) X)
-          ((AND (EQCAR X 'EQUAL) (NOT (CDDR X)))
-           (PUSH (LIST 'EQUAL (setq G (IS-GENSYM)) (SECOND X)) $IS-EQLIST) G)
-          ((MEMBER (FIRST X) '(LIST APPEND CONS VCONS))
-           (CONS (COND ((EQ (FIRST X) 'VCONS) 'CONS) ( (FIRST X)))
-                 (mapcar #'def-is-remdup1 (cdr x))))
-          ((ERRHUH)))))
-
 (defun LIST2CONS (X)
 "Produces LISP code for constructing a list, involving only CONS."
  (LIST2CONS-1 (CDR X)))