Combining GC passes

Below you are given a partial implementation of a plai/gc2 style collector for a simple heap with no freelist or bitmap in the style of Lecture 20. Unlike there, in this tutorial you are asked to combine the phase of marking white with that of freeing any records previously marked white.

Complete the function free/mark-white! so that the given tests pass. Your function should be equivalent to calling (free-white!) followed by the call to (mark-white!) that would normally have been in the next gc invokation.

Note:

You do not have to write the whole collector here.
Your solution should only traverse the heap once. In particular calling mark-white! or free-white! from free/mark-white! is not permitted.

(module+ test
  (with-heap (vector 'free 'flat 1)
    (free/mark-white!)
    (test (current-heap) #(free white-flat 1)))

  (with-heap (vector 'free 'white-flat 1)
    (free/mark-white!)
    (test (current-heap) #(free free free)))

  (with-heap (vector 'free 'cons 1 1)
    (free/mark-white!)
    (test (current-heap) #(free white-cons 1 1)))

  (with-heap (vector 'free 'cons 1 1)
    (free/mark-white!)
    (free/mark-white!)
    (test (current-heap) #(free free free free)))

  (with-heap (vector 'white-flat 0 'cons 0 0)
    (free/mark-white!)
    (test (current-heap) #(free free white-cons 0 0)))

  (with-heap (make-vector 7 '?)
    (init-allocator)
    (test (current-heap) (make-vector 7 'free))
    (gc:alloc-flat 'first)
    (test (current-heap) #(flat first free free free free free))
    (gc:alloc-flat 'rest)
    (test (current-heap) #(flat first flat rest free free free))
    (gc:cons 0 2)
    (test (current-heap) #(flat first flat rest cons 0 2))
    (free/mark-white!)
    (test (current-heap) #(white-flat first white-flat rest white-cons 0 2))
    (free/mark-white!)
    (test (current-heap)  (make-vector 7 'free))
    (gc:alloc-flat 'first)
    (gc:alloc-flat 'rest)
    (gc:cons 0 2)
    (free/mark-white!)
    (test (current-heap) #(white-flat first white-flat rest white-cons 0 2))
    )

  (with-heap  (vector 'flat 'first 'flat 'rest 'white-cons 0 2)
    (free/mark-white!)
    (test (current-heap) #(white-flat first white-flat rest free free free))
    (heap-set! 0 'flat)
    (free/mark-white!)
    (test (current-heap) #(white-flat first free free free free free)))

  (with-heap (make-vector 5 #f)
    (init-allocator)
    (gc:cons 0 0)
    (test (current-heap) #(cons 0 0 free free))
    (malloc 2)
    (test/exn (malloc 100) "out of memory")
    (heap-set! 0 'fail)
    (test/exn (malloc 2) "unexpected tag"))
  )