anchor.diff:          *result*)))
   
   (defun xp-print (fn stream args)
  -  (setf *result* (do-xp-printing fn stream args))
  -  (when *locating-circularities*
  -    (setf *locating-circularities* nil)
  -    (setf *abbreviation-happened* nil)
  -    (setf *parents* nil)
  -    (setf *result* (do-xp-printing fn stream args))))
  +  (when *print-circle*
  +    ;; First pass to locate circularities.
  +    (setf *result* (do-xp-printing fn stream args 0))
  +    (setf *abbreviation-happened* nil))
  +  (setf *result* (do-xp-printing fn stream args nil)))
   
   (defun decode-stream-arg (stream)
     (cond ((eq stream T) *terminal-io*)
           ((null stream) *standard-output*)
           (T stream)))
   
  -(defun do-xp-printing (fn stream args)
  -  (let ((xp (make-instance 'xp-structure :base-stream stream))
  +(defun do-xp-printing (fn stream args locating-circularities)
  +  (let ((xp (make-instance 'xp-structure
  +                           :base-stream stream
  +                           :locating-circularities (if locating-circularities
  +                                                       0
  +                                                       nil)))
           (*current-level* 0)
           (result nil))
       (catch 'line-limit-abbreviation-exit
         (start-block xp nil nil nil)
         (setf result (apply fn xp args))
         (end-block xp nil))
  -    (when (and *locating-circularities*
  -               (zerop *locating-circularities*) ;No circularities.
  +    #++ ; disabled, think this is a performance thing...
  +    (when (and (locating-circularities xp)
  +               (zerop (locating-circularities xp)) ;No circularities.
                  (= (line-no xp) 1)               ;Didn't suppress line.
                  (zerop (buffer-offset xp)))      ;Didn't suppress partial line.
  -      (setf *locating-circularities* nil))      ;print what you have got.
  +      (setf (locating-circularities xp) nil))      ;print what you have got.
       (when (catch 'line-limit-abbreviation-exit
               (attempt-to-output xp nil T) nil)
         (attempt-to-output xp T T))
       result))
   
   (defun write+ (object xp)
  -  (let ((*parents* *parents*))
  -    (unless (and *circularity-hash-table*
  -                (eq (circularity-process xp object nil) :subsequent))
  -      (when (and *circularity-hash-table* (consp object))
  -        ;;avoid possible double check in handle-logical-block.
  -        (setf object (cons (car object) (cdr object))))
  -      (let ((printer (if *print-pretty* (get-printer object *print-pprint-dispatch*) nil))
  +  (unless (and *circularity-hash-table*
  +               (eq (circularity-process xp object nil) :subsequent))
  +    (when (and *circularity-hash-table* (consp object))
  +      ;;avoid possible double check in handle-logical-block.
  +      (setf object (cons (car object) (cdr object))))
  +    (let ((printer (if *print-pretty* (get-printer object *print-pprint-dispatch*) nil))
  +          #+(or)
  +          type)
  +      (cond (printer (funcall printer xp object))
  +            ((maybe-print-fast xp object))
               #+(or)
  -            type)
  -        (cond (printer (funcall printer xp object))
  -              ((maybe-print-fast xp object))
  -              #+(or)
  -              ((and *print-pretty*
  -                    (symbolp (setf type (type-of object)))
  -                    (setf printer (get type 'structure-printer))
  -                    (not (eq printer :none)))
  -               (funcall printer xp object))
  -              ((and *print-pretty* *print-array* (arrayp object)
  -                    (not (stringp object)) (not (bit-vector-p object))
  -                    (not (structure-type-p (type-of object))))
  -               (pretty-array xp object))
  -              (T
  -               (non-pretty-print object xp)))))))
  +            ((and *print-pretty*
  +                  (symbolp (setf type (type-of object)))
  +                  (setf printer (get type 'structure-printer))
  +                  (not (eq printer :none)))
  +             (funcall printer xp object))
  +            ((and *print-pretty* *print-array* (arrayp object)
  +                  (not (stringp object)) (not (bit-vector-p object))
  +                  (not (structure-type-p (type-of object))))
  +             (pretty-array xp object))
  +            (T
  +             (non-pretty-print object xp))))))
   
   (defun non-pretty-print (object s)
     (let ((*print-level* (if *print-level*
  
positive.code: (defun output-position (&optional (s *standard-output*))
    (mezzano.gray:stream-line-column s))
  
  (defvar *locating-circularities* nil
    "Integer if making a first pass over things to identify circularities.
     Integer used as counter for #n= syntax.")
  (defvar *parents* nil "used when *print-shared* is nil")
  
  (defvar *circularity-hash-table* nil
    "Contains hash table used for locating circularities, or a stack.")
  ;When an entry is first made it is zero.
  ;If a duplicate is found, a positive integer tag is assigned.
  ;After the first time the object is printed out, the tag is negated.
  
  ;; circularity-hash-tables cache freed because thread safety.
  
  (defun get-circularity-hash-table ()
    (make-hash-table :test 'eq))
  
  ;If you call this, then the table gets efficiently recycled.
  
  (defun free-circularity-hash-table (table)
    (declare (ignore table)))
  
  ;                       ---- DISPATCHING ----
  
  
negative.code:      (setf circle-check? 'not-first-p))
    `(let ((*current-level* (1+ *current-level*))
           (*current-length* -1)
           ,@(if (and circle-check? atsign?) `((not-first-p (plusp *current-length*)))))
       (unless (check-block-abbreviation ,var ,args ,circle-check?)
         (block logical-block
  