anchor.diff:  
   (defmacro Qnext (index) `(+ ,index +queue-entry-size+))
   
  -(defvar *describe-xp-streams-fully* nil "Set to T to see more info.")
  -
  -(defun describe-xp (xp s depth)
  -  (declare (ignore depth))
  -  (cl:format s "#<XP stream ")
  +(defmethod describe-object ((xp xp-structure) s)
  +  (cl:format s "~S is an XP stream, " xp)
     (if (not (base-stream xp))
         (cl:format s "not currently in use")
         (cl:format s "outputting to ~S" (base-stream xp)))
     (when (base-stream xp)
       (cl:format s "~&buffer= ~S" (subseq (buffer xp) 0 (max (buffer-ptr xp) 0)))
  -    (when (not *describe-xp-streams-fully*) (cl:princ " ..." s))
  -    (when *describe-xp-streams-fully*
  -      (cl:format s "~&   pos   _123456789_123456789_123456789_123456789")
  -      (cl:format s "~&depth-in-blocks= ~D linel= ~D line-no= ~D line-limit= ~D"
  -                   (depth-in-blocks xp) (linel xp) (line-no xp) (line-limit xp))
  -      (when (or (char-mode xp) (not (zerop (char-mode-counter xp))))
  -        (cl:format s "~&char-mode= ~S char-mode-counter= ~D"
  -                     (char-mode xp) (char-mode-counter xp)))
  -      (unless (minusp (block-stack-ptr xp))
  -        (cl:format s "~&section-start")
  -        (do ((save (block-stack-ptr xp)))
  -            ((minusp (block-stack-ptr xp)) (setf (block-stack-ptr xp) save))
  -          (cl:format s " ~D" (section-start xp))
  -          (pop-block-stack xp)))
  -      (cl:format s "~&linel= ~D charpos= ~D buffer-ptr= ~D buffer-offset= ~D"
  -                   (linel xp) (charpos xp) (buffer-ptr xp) (buffer-offset xp))
  -      (unless (minusp (prefix-stack-ptr xp))
  -        (cl:format s "~&prefix= ~S"
  -                     (subseq (prefix xp) 0 (max (prefix-ptr xp) 0)))
  -        (cl:format s "~&suffix= ~S"
  -                     (subseq (suffix xp) 0 (max (suffix-ptr xp) 0))))
  -      (unless (> (Qleft xp) (Qright xp))
  -        (cl:format s "~&ptr type         kind           pos depth end offset arg")
  -        (do ((p (Qleft xp) (Qnext p))) ((> p (Qright xp)))
  -          (cl:format s "~&~4A~13A~15A~4A~6A~4A~7A~A"
  -            (/ (- p (Qleft xp)) +queue-entry-size+)
  -            (Qtype xp p)
  -            (if (member (Qtype xp p) '(:newline :ind)) (Qkind xp p) "")
  -            (BP<-TP xp (Qpos xp p))
  -            (Qdepth xp p)
  -            (if (not (member (Qtype xp p) '(:newline :start-block))) ""
  -                (and (Qend xp p)
  -                     (/ (- (+ p (Qend xp p)) (Qleft xp)) +queue-entry-size+)))
  -            (if (not (eq (Qtype xp p) :start-block)) ""
  -                (and (Qoffset xp p)
  -                     (/ (- (+ p (Qoffset xp p)) (Qleft xp)) +queue-entry-size+)))
  -            (if (not (member (Qtype xp p) '(:ind :start-block :end-block))) ""
  -                (Qarg xp p)))))
  -      (unless (minusp (prefix-stack-ptr xp))
  -        (cl:format s "~&initial-prefix-ptr prefix-ptr suffix-ptr non-blank start-line")
  -        (do ((save (prefix-stack-ptr xp)))
  -            ((minusp (prefix-stack-ptr xp)) (setf (prefix-stack-ptr xp) save))
  -          (cl:format s "~& ~19A~11A~11A~10A~A"
  -                       (initial-prefix-ptr xp) (prefix-ptr xp) (suffix-ptr xp)
  -                       (non-blank-prefix-ptr xp) (section-start-line xp))
  -          (pop-prefix-stack xp)))))
  -    (cl:princ ">" s)
  -    (values))
  -
  -;This maintains a list of XP structures.  We save them
  -;so that we don't have to create new ones all of the time.
  -;We have separate objects so that many can be in use at once.
  -
  -;(Note should really be doing some locking here, but CL does not have the
  -;primitives for it.  There is a tiny probability here that two different
  -;processes could end up trying to use the same xp-stream)
  -
  -(defvar *free-xps* nil "free list of XP stream objects") ; never bound
  -
  -(defun get-pretty-print-stream (stream)
  -  (initialize-xp (make-xp-structure) stream))
  -
  -;If you call this, the xp-stream gets efficiently recycled.
  -
  -(defun free-pretty-print-stream (xp)
  -  (declare (ignore xp)))
  -
  -;This is called to initialize things when you start pretty printing.
  -
  -(defun initialize-xp (xp stream)
  -  (setf (base-stream xp) stream)
  +    (cl:format s "~&   pos   _123456789_123456789_123456789_123456789")
  +    (cl:format s "~&depth-in-blocks= ~D linel= ~D line-no= ~D line-limit= ~D"
  +               (depth-in-blocks xp) (linel xp) (line-no xp) (line-limit xp))
  +    (when (or (char-mode xp) (not (zerop (char-mode-counter xp))))
  +      (cl:format s "~&char-mode= ~S char-mode-counter= ~D"
  +                 (char-mode xp) (char-mode-counter xp)))
  +    (unless (minusp (block-stack-ptr xp))
  +      (cl:format s "~&section-start")
  +      (do ((save (block-stack-ptr xp)))
  +          ((minusp (block-stack-ptr xp)) (setf (block-stack-ptr xp) save))
  +        (cl:format s " ~D" (section-start xp))
  +        (pop-block-stack xp)))
  +    (cl:format s "~&linel= ~D charpos= ~D buffer-ptr= ~D buffer-offset= ~D"
  +               (linel xp) (charpos xp) (buffer-ptr xp) (buffer-offset xp))
  +    (unless (minusp (prefix-stack-ptr xp))
  +      (cl:format s "~&prefix= ~S"
  +                 (subseq (prefix xp) 0 (max (prefix-ptr xp) 0)))
  +      (cl:format s "~&suffix= ~S"
  +                 (subseq (suffix xp) 0 (max (suffix-ptr xp) 0))))
  +    (unless (> (Qleft xp) (Qright xp))
  +      (cl:format s "~&ptr type         kind           pos depth end offset arg")
  +      (do ((p (Qleft xp) (Qnext p))) ((> p (Qright xp)))
  +        (cl:format s "~&~4A~13A~15A~4A~6A~4A~7A~A"
  +                   (/ (- p (Qleft xp)) +queue-entry-size+)
  +                   (Qtype xp p)
  +                   (if (member (Qtype xp p) '(:newline :ind)) (Qkind xp p) "")
  +                   (BP<-TP xp (Qpos xp p))
  +                   (Qdepth xp p)
  +                   (if (not (member (Qtype xp p) '(:newline :start-block))) ""
  +                       (and (Qend xp p)
  +                            (/ (- (+ p (Qend xp p)) (Qleft xp)) +queue-entry-size+)))
  +                   (if (not (eq (Qtype xp p) :start-block)) ""
  +                       (and (Qoffset xp p)
  +                            (/ (- (+ p (Qoffset xp p)) (Qleft xp)) +queue-entry-size+)))
  +                   (if (not (member (Qtype xp p) '(:ind :start-block :end-block))) ""
  +                       (Qarg xp p)))))
  +    (unless (minusp (prefix-stack-ptr xp))
  +      (cl:format s "~&initial-prefix-ptr prefix-ptr suffix-ptr non-blank start-line")
  +      (do ((save (prefix-stack-ptr xp)))
  +          ((minusp (prefix-stack-ptr xp)) (setf (prefix-stack-ptr xp) save))
  +        (cl:format s "~& ~19A~11A~11A~10A~A"
  +                   (initial-prefix-ptr xp) (prefix-ptr xp) (suffix-ptr xp)
  +                   (non-blank-prefix-ptr xp) (section-start-line xp))
  +        (pop-prefix-stack xp)))))
  +
  +(defmethod initialize-instance :after ((xp xp-structure) &key &allow-other-keys)
     (setf (linel xp) (max 0 (cond (*print-right-margin*)
  -                                ((output-width stream))
  +                                ((output-width (base-stream xp)))
                                   (T *default-right-margin*))))
     (setf (line-limit xp) *print-lines*)
     (setf (line-no xp) 1)
     (setf (char-mode xp) nil)
     (setf (char-mode-counter xp) 0)
     (setf (depth-in-blocks xp) 0)
  +  (setf (block-stack xp) (make-array +block-stack-min-size+))
     (setf (block-stack-ptr xp) 0)
  -  (setf (charpos xp) (cond ((output-position stream)) (T 0)))
  +  (setf (buffer xp) (make-array +buffer-min-size+ :element-type 'character))
  +  (setf (charpos xp) (cond ((output-position (base-stream xp)))
  +                           (T 0)))
     (setf (section-start xp) 0)
     (setf (buffer-ptr xp) 0)
     (setf (buffer-offset xp) (charpos xp))
  +  (setf (queue xp) (make-array +queue-min-size+))
     (setf (Qleft xp) 0)
     (setf (Qright xp) (- +queue-entry-size+))
  +  (setf (prefix xp) (make-array +buffer-min-size+ :element-type 'character))
  +  (setf (prefix-stack xp) (make-array +prefix-stack-min-size+))
     (setf (prefix-stack-ptr xp) (- +prefix-stack-entry-size+))
  -  xp)
  +  (setf (suffix xp) (make-array +buffer-min-size+ :element-type 'character)))
   
   ;The char-mode stuff is a bit tricky.
   ;one can be in one of the following modes:
  
positive.code:    ;; Line position (eg (+ BUFFER-PTR CHARPOS)).  Indentations are stored in this form.
     ;; Total position if all on one line (eg (+ BUFFER-PTR BUFFER-OFFSET))
     ;;  Positions are stored in this form.
     (queue :initarg :queue :initform (make-array +queue-min-size+) :accessor queue)
     (qleft :initarg :qleft :initform nil :accessor qleft)
     (qright :initarg :qright :initform nil :accessor qright)
     ;;This holds a queue of action descriptors.  QLEFT and QRIGHT
     ;;point to the next entry to dequeue and the last entry enqueued
     ;;respectively.  The queue is empty when
  
negative.code:     (when (catch 'line-limit-abbreviation-exit
              (attempt-to-output xp nil T) nil)
        (attempt-to-output xp T T))
      result))
  
  (defun write+ (object xp)
  