anchor.diff:                *newspace-paging-bits* *oldspace-paging-bits*
                 *newspace-offset* 0
                 *static-mark-bit* (logxor *static-mark-bit* 1))
  -       ;; Transport the major root, NIL.
  -       (gc-object 'nil)
  -       ;; Transport registers, the data stack and the binding stack.
  -       (transport-registers-and-stack 1 2 3 4 5)
  +       ;; Scavenge NIL to start things off.
  +       (scavenge-object 'nil)
  +       ;; And scavenge the current registers and stacks.
  +       (scavenge-current-stack-group 1 2 3 4 5)
  +       ;; Now do the bulk of the work by scavenging newspace.
  +       (scavenge-newspace)
          ;; Make oldspace inaccessible.
          (setf (ldb (byte 2 0) (memref-unsigned-byte-32 *oldspace-paging-bits* 0)) 0)
          ;; Flush TLB.
  
positive.code:       (return-from mark-static-object))
      (setf (ldb (byte 1 0) (memref-unsigned-byte-64 address -1)) *static-mark-bit*)
      (with-gc-trace (object #\s)
        (scan-object object nil))))
  
  (defun gc-object (object)
    (when (or (fixnump object)
              (floatp object)
              (eql (%tag-field object) +tag-unbound-value+))
      ;; Attempting to shift the pointer-field of negative fixnums
      ;; about will cause a fixnum overflow.
      ;; TLS-unbound tags also have the same issue.
      (return-from gc-object object))
    (let ((address (ash (%pointer-field object) 4)))
      (cond ((characterp object)
             ;; Do nothing with immediate objects.
             object)
            ((oldspace-pointer-p address)
             ;; Object is in oldspace, transport to newspace.
             (scan-and-transport object))
            ((newspace-pointer-p address)
             ;; Object is already in newspace.
             ;; Can this ever happen??
             object)
            ((static-pointer-p address)
             ;; Object is in the static area, mark and scan.
             (mark-static-object object)
             object)
            (t
             ;; Assume the pointer is on the stack.
             ;; TODO: Track scanned stack objects. Allocate a cons with dynamic-extent
             ;; and push on some symbol.
             (scan-object object nil)))))
  
  ;;; Arguments and MV return are to force the data registers on to the stack.
  ;;; This does not work for RBX or R13, but RBX is smashed by the function
  ;;; return and R13 will be holding a newspace pointer by the time this
  ;;; function is called.
  (defun transport-registers-and-stack (a1 a2 a3 a4 a5)
    (let* ((sg-pointer (ash (%pointer-field (current-stack-group)) 4))
  	 (ds-base (memref-unsigned-byte-64 sg-pointer 7))
  	 (ds-size (memref-unsigned-byte-64 sg-pointer 8))
  	 (bs-base (memref-unsigned-byte-64 sg-pointer 9))
  	 (bs-size (memref-unsigned-byte-64 sg-pointer 10))
           (binding-stack-pointer (memref-unsigned-byte-64 sg-pointer 1))
           (data-stack-pointer (ash (%%get-data-stack-pointer) 3)))
      (mumble "Scanning control stack")
      (do ((fp (read-frame-pointer)
               (memref-unsigned-byte-64 fp 0)))
          ((= fp 0))
        (setf (memref-t fp -2)
              (gc-object (memref-t fp -2))))
      (mumble "Scanning data stack")
      (dotimes (i (ash (- (+ ds-base ds-size) data-stack-pointer) -3))
        (setf (memref-t data-stack-pointer i)
              (gc-object (memref-t data-stack-pointer i))))
      (mumble "Scanning binding stack")
      (dotimes (i (ash (- (+ bs-base bs-size) binding-stack-pointer) -3))
        (setf (memref-t binding-stack-pointer i)
              (gc-object (memref-t binding-stack-pointer i)))))
    (values a1 a2 a3 a4 a5))
  
  ;;; TODO: This needs to coalesce adjacent free areas.
  (defun sweep-static-space (space)
  
negative.code: (defun static-pointer-p (address)
    (< address #x80000000))
  
  (declaim (inline immediatep))
  (defun immediatep (object)
    "Return true if OBJECT is an immediate object."
    (case (%tag-field object)
      ((#.+tag-even-fixnum+ #.+tag-odd-fixnum+
        #.+tag-character+ #.+tag-single-float+
        #.+tag-unbound-value+)
       t)
      (t nil)))
  
  (defmacro with-gc-trace ((object prefix) &body body)
    (let ((object-sym (gensym))
  