EphemeronのGC疑似コード

ephemeron-gc-pseudo.scm

(DEFINE ephemeron-queue '())

(DEFINE (trace-pointer-queueing-ephemerons obj)
   (UNLESS (MARKED? obj)
      (MARK-OBJECT! obj)
      (IF (EPHEMERON? obj)
         (PUSH! ephemeron-queue obj)
         (FOR-EACH trace-pointer-queueing-ephemerons
                   (REF-POINTERS obj)))))

(DEFINE (trace-pointer obj)
   (UNLESS (MARKED? obj)
      (MARK-OBJECT! obj)
      (FOR-EACH trace-pointer
                (REF-POINTERS obj))))

(DEFINE (mark-phase1)
   (FOR-EACH trace-pointer-queueing-ephemerons roots))

(DEFINE (mark-phase2)
   (LET ((reachable-properties
           (FILTER EPHEMERON-KEY-MARKED?  ephemeron-queue)))
      (UNLESS (NULL? reachable-properties)
         (SET! ephemeron-queue
               (REMOVE EPHEMERON-KEY-MARKED?  ephemeron-queue))
         (FOR-EACH (LAMBDA (ephemeron)
                     (trace-pointer-queueing-ephemerons
                       (EPHEMERON-VALUE ephemeron)))
                   reachable-properties)
         (mark-phase2))))

(DEFINE (mark-phase3)
   (FOR-EACH (LAMBDA (ephemeron)
               (SIGNAL ephemeron 'ALMOST-COLLECTABLE)
               (trace-pointer (EPHEMERON-KEY ephemeron))
               (trace-pointer (EPHEMERON-VALUE ephemeron)))
             ephemeron-queue))

(DEFINE (garbage-collect-mark)
   (mark-phase1)
   (mark-phase2)
   (mark-phase3))