anchor.diff:      (incf total-used (truncate *general-area-bump* 8))
       (incf total (truncate *general-area-limit* 8))
       (when (eql verbosity t)
  -      (multiple-value-bind (n-allocated-objects allocated-object-sizes)
  -          (general-area-info)
  -        (print-n-allocated-objects-table n-allocated-objects allocated-object-sizes)))
  +      (multiple-value-bind (allocated-words total-words largest-free-space n-allocated-objects allocated-object-sizes allocated-classes)
  +          (area-info :general)
  +        (declare (ignore allocated-words total-words largest-free-space))
  +        (print-n-allocated-objects-table n-allocated-objects allocated-object-sizes allocated-classes)))
       (format t "Cons area: ~:D/~:D words used (~D%).~%"
               (truncate *cons-area-bump* 8) (truncate *cons-area-limit* 8)
               (truncate (* *cons-area-bump* 100) *cons-area-limit*))
       (incf total-used (truncate *cons-area-bump* 8))
       (incf total (truncate *cons-area-limit* 8))
  -    (multiple-value-bind (allocated-words total-words largest-free-space n-allocated-objects allocated-object-sizes)
  -        (pinned-area-info (* 2 1024 1024) *wired-area-bump*)
  +    (when (eql verbosity t)
  +      (multiple-value-bind (allocated-words total-words largest-free-space n-allocated-objects allocated-object-sizes allocated-classes)
  +          (area-info :cons)
  +        (declare (ignore allocated-words total-words largest-free-space))
  +        (print-n-allocated-objects-table n-allocated-objects allocated-object-sizes allocated-classes)))
  +    (multiple-value-bind (allocated-words total-words largest-free-space n-allocated-objects allocated-object-sizes allocated-classes)
  +        (area-info :wired)
         (format t "Wired area: ~:D/~:D words allocated (~D%).~%"
                 allocated-words total-words
                 (truncate (* allocated-words 100) total-words))
  
positive.code:     (format t "~:D words to next GC.~%" (truncate *memory-expansion-remaining* 8)))
    (values))
  
  (defun general-area-info ()
    (let ((n-allocated-objects (make-array (ash 1 +object-type-size+)
                                           :initial-element 0))
          (allocated-objects-sizes (make-array (ash 1 +object-type-size+)
                                               :initial-element 0))
          (finger 0))
      (mezzano.supervisor:with-world-stopped ()
        (loop
           (when (eql finger *general-area-bump*)
             (return))
           (let* ((object (%%assemble-value (logior finger
                                                    (ash +address-tag-general+ +address-tag-shift+)
                                                    *dynamic-mark-bit*)
                                            +tag-object+))
                  (size (object-size object)))
             (incf (svref n-allocated-objects (%object-tag object)))
             (incf (svref allocated-objects-sizes (%object-tag object)) size)
             (when (oddp size)
               (incf size))
             (scan-object object)
             (incf finger (* size 8)))))
      (values n-allocated-objects allocated-objects-sizes)))
  
  (defun pinned-area-info (base limit)
    ;; Yup. Scanning a pinned area atomically requires the world to be stopped.
    (let ((n-allocated-objects (make-array (ash 1 +object-type-size+)
                                           :initial-element 0))
          (allocated-objects-sizes (make-array (ash 1 +object-type-size+)
                                               :initial-element 0)))
      (mezzano.supervisor:with-world-stopped
        (let ((allocated-words 0)
              (total-words 0)
              (largest-free-space 0)
              (address base))
          (loop
             (when (>= address limit)
               (return))
             (let ((size (align-up (size-of-pinned-area-allocation address) 2))
                   ;; Carefully read the type, avoid bignums.
                   (type (ldb (byte +object-type-size+ +object-type-shift+)
                              (memref-unsigned-byte-8 address 0))))
               (incf (svref n-allocated-objects type))
               (incf (svref allocated-objects-sizes type) size)
               (incf total-words size)
               (cond ((not (eql type +object-tag-freelist-entry+))
                      (incf allocated-words size))
                     (t ; free block.
                      (setf largest-free-space (max largest-free-space size))))
               (incf address (* size 8))))
          (values allocated-words total-words largest-free-space n-allocated-objects allocated-objects-sizes)))))
  
  (defun gc ()
    "Run a garbage-collection cycle."
  
negative.code:       (incf total-used allocated-words)
        (incf total total-words)
        (when (eql verbosity t)
          (print-n-allocated-objects-table n-allocated-objects allocated-object-sizes allocated-classes)))
      (multiple-value-bind (allocated-words total-words largest-free-space n-allocated-objects allocated-object-sizes allocated-classes)
          (area-info :pinned)
        (format t "Pinned area: ~:D/~:D words allocated (~D%).~%"
                allocated-words total-words
                (truncate (* allocated-words 100) total-words))
  