diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet
index fee1c0a..2d780fb 100644
--- a/books/bookvol5.pamphlet
+++ b/books/bookvol5.pamphlet
@@ -2307,7 +2307,23 @@ contiguous comment spanning enough lines to overflow the stack.
 \calls{inclmsgPrematureEOF}{origin}
 <<defun inclmsgPrematureEOF>>=
 (defun |inclmsgPrematureEOF| (ufo)
- (list 'S2CI0002 (list (|%origin| ufo))))
+ (list 'S2CI0002 (list (|theorigin| ufo))))
+
+@
+
+\defun{theorigin}{theorigin}
+<<defun theorigin>>=
+(defun |theorigin| (x) (list #'|porigin| x))
+
+@
+
+\defun{porigin}{porigin}
+\calls{porigin}{stringp}
+<<defun porigin>>=
+(defun |porigin| (x)
+ (if (stringp x)
+  x
+  (|pfname| x)))
 
 @
 
@@ -2351,7 +2367,13 @@ contiguous comment spanning enough lines to overflow the stack.
 \calls{inclmsgSay}{id}
 <<defun inclmsgSay>>=
 (defun |inclmsgSay| (str)
- (list 'S2CI0001 (list (|%id| str))))
+ (list 'S2CI0001 (list (|theid| str))))
+
+@
+
+\defun{theid}{theid}
+<<defun theid>>=
+(defun |theid| (a) (list identity a))
 
 @
 
@@ -2365,10 +2387,24 @@ contiguous comment spanning enough lines to overflow the stack.
 @
 
 \defun{inclmsgNoSuchFile}{inclmsgNoSuchFile}
-\calls{inclmsgNoSuchFile}{fname}
+\calls{inclmsgNoSuchFile}{thefname}
 <<defun inclmsgNoSuchFile>>=
 (defun |inclmsgNoSuchFile| (fn)
- (list 'S2CI0010 (list (|%fname| fn))))
+ (list 'S2CI0010 (list (|thefname| fn))))
+
+@
+
+\defun{thefname}{thefname}
+\calls{thefname}{pfname}
+<<defun thefname>>=
+(defun |thefname| (x) (list #'|pfname| x))
+
+@
+
+\defun{pfname}{pfname}
+\calls{pfname}{PathnameString}
+<<defun pfname>>=
+(defun |pfname| (x) (|PathnameString| x))
 
 @
 
@@ -2382,10 +2418,10 @@ contiguous comment spanning enough lines to overflow the stack.
 @
 
 \defun{inclmsgCannotRead}{inclmsgCannotRead}
-\calls{inclmsgCannotRead}{fname}
+\calls{inclmsgCannotRead}{thefname}
 <<defun inclmsgCannotRead>>=
 (defun |inclmsgCannotRead| (fn)
- (list 'S2CI0011 (list (|%fname| fn))))
+ (list 'S2CI0011 (list (|thefname| fn))))
 
 @
 
@@ -2436,7 +2472,7 @@ contiguous comment spanning enough lines to overflow the stack.
        (setq Var9 (cdr Var9))))
      nil flist nil)
     (cons f1 nil)))
-  (list 'S2CI0004 (list (|%id| cycle) (|%id| f1)))))
+  (list 'S2CI0004 (list (|theid| cycle) (|theid| f1)))))
 
 @
 
@@ -2453,7 +2489,7 @@ contiguous comment spanning enough lines to overflow the stack.
 \calls{inclmsgConActive}{id}
 <<defun inclmsgConActive>>=
 (defun |inclmsgConActive| (n)
- (list 'S2CI0006 (list (|%id| n))))
+ (list 'S2CI0006 (list (|theid| n))))
 
 @
 
@@ -2470,7 +2506,7 @@ contiguous comment spanning enough lines to overflow the stack.
 \calls{inclmsgConStill}{id}
 <<defun inclmsgConStill>>=
 (defun |inclmsgConStill| (n)
- (list 'S2CI0007 (list (|%id| n))))
+ (list 'S2CI0007 (list (|theid| n))))
 
 @
 
@@ -2521,7 +2557,7 @@ contiguous comment spanning enough lines to overflow the stack.
 \calls{inclmsgPrematureFin}{origin}
 <<defun inclmsgPrematureFin>>=
 (defun |inclmsgPrematureFin| (ufo)
- (list 'S2CI0003 (list (|%origin| ufo))))
+ (list 'S2CI0003 (list (|theorigin| ufo))))
 
 @
 
@@ -2569,7 +2605,9 @@ contiguous comment spanning enough lines to overflow the stack.
 <<defun inclmsgIfSyntax>>=
 (defun |inclmsgIfSyntax| (ufo found context)
  (setq found (concat ")" found))
- (list 'S2CI0009 (list (|%id| found) (|%id| context) (|%origin| ufo))))
+ (list 'S2CI0009 (list (|theid| found)
+                       (|theid| context)
+                       (|theorigin| ufo))))
 
 @
 
@@ -5307,6 +5345,27 @@ isKeyQualityP (key,qual)  ==
 
 @
 
+\defun{ppos}{ppos}
+\calls{ppos}{pfNoPosition?}
+\calls{ppos}{pfImmediate?}
+\calls{ppos}{pfCharPosn}
+\calls{ppos}{pfLinePosn}
+\calls{ppos}{porigin}
+\calls{ppos}{pfFileName}
+<<defun ppos>>=
+(defun |ppos| (p)
+ (let (org lpos cpos)
+  (cond
+   ((|pfNoPosition?| p) (list "no position"))
+   ((|pfImmediate?| p) (list "console"))
+   (t
+    (setq cpos (|pfCharPosn| p))
+    (setq lpos (|pfLinePosn| p))
+    (setq org (|porigin| (|pfFileName| p)))
+    (list org " " "line" " " lpos)))))
+ 
+@
+
 \defun{remFile}{remFile}
 \calls{remFile}{IFCDR}
 \calls{remLine}{IFCAR}
@@ -25327,9 +25386,7 @@ $traceletflag
 currenttime
 error
 expand-tabs
-|%fname|
 |incAppend|
-|%id|
 |intInterpretPform|
 |intnplisp|
 |intSayKeyedMsg|
@@ -25345,7 +25402,6 @@ maxindex
 |ncloopProcess|
 |next|
 |npParse|
-|%origin|
 |%pform|
 |poGlobalLinePosn|
 |porigin|
@@ -25791,6 +25847,7 @@ maxindex
 
 <<defun pcounters>>
 <<defun pfAbSynOp?>>
+<<defun pfname>>
 <<defun pfNoPosition>>
 <<defun pfNoPosition?>>
 <<defun phBegin>>
@@ -25816,8 +25873,10 @@ maxindex
 <<defun poNoPosition>>
 <<defun poNoPosition?>>
 <<defun poPosImmediate?>>
+<<defun porigin>>
 <<defun posend>>
 <<defun posPointers>>
+<<defun ppos>>
 <<defun pquit>>
 <<defun pquitSpad2Cmd>>
 <<defun previousInterpreterFrame>>
@@ -25992,6 +26051,9 @@ maxindex
 <<defun ?t>>
 <<defun tabbing>>
 <<defun terminateSystemCommand>>
+<<defun theid>>
+<<defun thefname>>
+<<defun theorigin>>
 <<defun thisPosIsEqual>>
 <<defun thisPosIsLess>>
 <<defun toFile?>>
diff --git a/changelog b/changelog
index 8bbd5f3..47ae9ce 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,8 @@
+20091218 tpd src/axiom-website/patches.html 20091218.03.tpd.patch
+20091218 tpd src/interp/Makefile remove cformat.lisp
+20091218 tpd src/interp/format.lisp add documentation from cformat
+20091218 tpd src/interp/cformat.lisp removed, merged with bookvol5
+20091218 tpd books/bookvol5 tree-shake more functions into interpreter
 20091218 tpd src/axiom-website/patches.html 20091218.02.tpd.patch
 20091218 tpd books/bookvol10.4 document RepeatedSquaring
 20091218 tpd src/axiom-website/patches.html 20091218.01.tpd.patch
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 2cf660b..91e6cf9 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -2316,5 +2316,7 @@ books/bookvol5 )describe no longer needs cat, dom, pkg arg<br/>
 books/bookvol5 tree shake code from cparse, posit, vmlisp<br/>
 <a href="patches/20091218.02.tpd.patch">20091218.02.tpd.patch</a>
 books/bookvol10.4 document RepeatedSquaring<br/>
+<a href="patches/20091218.03.tpd.patch">20091218.02.tpd.patch</a>
+books/bookvol5 tree shake code from cformat, remove cformat.lisp<br/>
  </body>
 </html>
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index ae5c90f..c4ce65d 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -142,7 +142,7 @@ and graphics.
 OBJS= ${OUT}/vmlisp.${O}      \
       ${OUT}/alql.${O}        ${OUT}/buildom.${O} \
       ${OUT}/cattable.${O}    \
-      ${OUT}/cformat.${O}     ${OUT}/cfuns.${O} \
+      ${OUT}/cfuns.${O} \
       ${OUT}/clam.${O}        ${OUT}/clammed.${O} \
       ${OUT}/compat.${O}      ${OUT}/compress.${O} \
       ${OUT}/cparse.${O}      \
@@ -3468,29 +3468,6 @@ ${MID}/posit.lisp: ${IN}/posit.lisp.pamphlet
 
 @
 
-\subsection{cformat.lisp}
-<<cformat.o (OUT from MID)>>=
-${OUT}/cformat.${O}: ${MID}/cformat.lisp
-	@ echo 136 making ${OUT}/cformat.${O} from ${MID}/cformat.lisp
-	@ ( cd ${MID} ; \
-	  if [ -z "${NOISE}" ] ; then \
-	   echo '(progn  (compile-file "${MID}/cformat.lisp"' \
-             ':output-file "${OUT}/cformat.${O}") (${BYE}))' | ${DEPSYS} ; \
-	  else \
-	   echo '(progn  (compile-file "${MID}/cformat.lisp"' \
-             ':output-file "${OUT}/cformat.${O}") (${BYE}))' | ${DEPSYS} \
-             >${TMP}/trace ; \
-	  fi )
-
-@
-<<cformat.lisp (MID from IN)>>=
-${MID}/cformat.lisp: ${IN}/cformat.lisp.pamphlet
-	@ echo 137 making ${MID}/cformat.lisp from ${IN}/cformat.lisp.pamphlet
-	@ (cd ${MID} ; \
-	   ${TANGLE} ${IN}/cformat.lisp.pamphlet >cformat.lisp )
-
-@
-
 \subsection{varini.lisp}
 <<varini.o (OUT from MID)>>=
 ${OUT}/varini.${O}: ${MID}/varini.lisp
@@ -3984,9 +3961,6 @@ clean:
 <<c-doc.o (OUT from MID)>>
 <<c-doc.lisp (MID from IN)>>
 
-<<cformat.o (OUT from MID)>>
-<<cformat.lisp (MID from IN)>>
-
 <<cfuns.o (OUT from MID)>>
 <<cfuns.lisp (MID from IN)>>
 
diff --git a/src/interp/cformat.lisp.pamphlet b/src/interp/cformat.lisp.pamphlet
deleted file mode 100644
index d13b267..0000000
--- a/src/interp/cformat.lisp.pamphlet
+++ /dev/null
@@ -1,143 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp cformat.lisp}
-\author{The Axiom Team}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-<<*>>=
-
-(IN-PACKAGE "BOOT")
-
-;--% Formatting functions for various compiler data objects.
-;--  These are used as [%origin o, %id n] for %1f %2f... style arguments
-;--  in a keyed message.
-;--  SMW, SG June 88
- 
-;%id a     == [IDENTITY, a]
-
-(DEFUN |%id| (|a|) (PROG NIL (RETURN (LIST IDENTITY |a|))))
-
-;-- Union(FileName,"strings","console")
-;%origin x ==
-;    [function porigin, x]
-
-(DEFUN |%origin| (|x|)
- (PROG NIL (RETURN (LIST (FUNCTION |porigin|) |x|))))
-
-;porigin x ==
-;    (STRINGP x => x; pfname x)
-
-(DEFUN |porigin| (|x|)
- (PROG () 
-  (RETURN
-   (COND
-    ((STRINGP |x|) |x|)
-    ((QUOTE T) (|pfname| |x|))))))
-
- 
-;%fname x ==
-;    [function pfname, x]
-
-(DEFUN |%fname| (|x|) (PROG NIL (RETURN (LIST (FUNCTION |pfname|) |x|))))
-
-;pfname x ==
-;    PathnameString x
- 
-(DEFUN |pfname| (|x|) (PROG NIL (RETURN (|PathnameString| |x|))))
-
-;%pos p == [function ppos, p]
-
-(DEFUN |%pos| (|p|) (PROG NIL (RETURN (LIST (FUNCTION |ppos|) |p|))))
-
-;ppos p ==
-;    pfNoPosition? p => ['"no position"]
-;    pfImmediate? p  => ['"console"]
-;    cpos := pfCharPosn p
-;    lpos := pfLinePosn p
-;    org  := porigin pfFileName p
-;    [org,'" ",'"line",'" ",lpos]
-
-(DEFUN |ppos| (|p|)
- (PROG (|org| |lpos| |cpos|)
-  (RETURN
-   (COND
-    ((|pfNoPosition?| |p|) (LIST "no position"))
-    ((|pfImmediate?| |p|) (LIST "console"))
-    ((QUOTE T)
-     (PROGN
-      (SETQ |cpos| (|pfCharPosn| |p|))
-      (SETQ |lpos| (|pfLinePosn| |p|))
-      (SETQ |org| (|porigin| (|pfFileName| |p|)))
-      (LIST |org| " " "line" " " |lpos|)))))))
- 
-;%key keyStuff == [function pkey, keyStuff]
-
-(DEFUN |%key| (|keyStuff|)
- (PROG NIL (RETURN (LIST (FUNCTION |pkey|) |keyStuff|))))
-
-;--keyStuff ::= keynumber | [ one or more keySeqs ]
-;--keySeq   ::= keynumber optargList optdbn
-;--optARgL  ::= [ 0 or more arguments ] | nothing at all
-;--optDbn   ::= ['dbN , databaseName ] | nothing at all
-;----------- (override in format.boot.pamphlet)
-;pkey keyStuff ==
-;    if not PAIRP keyStuff then keyStuff := [keyStuff]
-;    allMsgs := []
-;    while not null keyStuff repeat
-;        dbN := NIL
-;        argL := NIL
-;        key := first keyStuff
-;        keyStuff := IFCDR keyStuff
-;        next := IFCAR keyStuff
-;        while PAIRP next repeat
-;            if CAR next = 'dbN then dbN := CADR next
-;            else argL := next
-;            keyStuff  := IFCDR keyStuff
-;            next      := IFCAR keyStuff
-;        oneMsg  := returnStLFromKey(key,argL,dbN)
-;        allMsgs := NCONC (oneMsg,allMsgs)
-;    allMsgs
- 
-(DEFUN |pkey| (|keyStuff|)
- (PROG (|oneMsg| |next| |key| |argL| |dbN| |allMsgs|)
-  (RETURN
-   (PROGN
-    (COND ((NULL (CONSP |keyStuff|)) (SETQ |keyStuff| (LIST |keyStuff|))))
-    (SETQ |allMsgs| NIL)
-    ((LAMBDA () 
-      (LOOP
-       (COND
-        ((NULL |keyStuff|) (RETURN NIL))
-        (#0=(QUOTE T)
-         (PROGN
-          (SETQ |dbN| NIL)
-          (SETQ |argL| NIL)
-          (SETQ |key| (CAR |keyStuff|))
-          (SETQ |keyStuff| (IFCDR |keyStuff|))
-          (SETQ |next| (IFCAR |keyStuff|))
-          ((LAMBDA () 
-           (LOOP
-            (COND
-             ((NOT (CONSP |next|)) (RETURN NIL))
-             (#0#
-              (PROGN
-               (COND
-                ((EQ (CAR |next|) (QUOTE |dbN|)) (SETQ |dbN| (CADR |next|)))
-                ((QUOTE T) (SETQ |argL| |next|)))
-               (SETQ |keyStuff| (IFCDR |keyStuff|))
-               (SETQ |next| (IFCAR |keyStuff|))))))))
-          (SETQ |oneMsg| (|returnStLFromKey| |key| |argL| |dbN|))
-          (SETQ |allMsgs| (NCONC |oneMsg| |allMsgs|))))))))
-    |allMsgs|))))
- 
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}
diff --git a/src/interp/format.lisp.pamphlet b/src/interp/format.lisp.pamphlet
index 99f778f..5786184 100644
--- a/src/interp/format.lisp.pamphlet
+++ b/src/interp/format.lisp.pamphlet
@@ -2855,7 +2855,10 @@
                                   (APPEND G168026
                                           (CONS BLANK (CONS |y| NIL)))))))))))))
 
-;--------------------> NEW DEFINITION (see cformat.boot.pamphlet)
+;--keyStuff ::= keynumber | [ one or more keySeqs ]
+;--keySeq   ::= keynumber optargList optdbn
+;--optARgL  ::= [ 0 or more arguments ] | nothing at all
+;--optDbn   ::= ['dbN , databaseName ] | nothing at all
 ;pkey keyStuff ==
 ;    if not PAIRP keyStuff then keyStuff := [keyStuff]
 ;    allMsgs := ['" "]