;;;; heap-o-rama.scm


#>
#include "low-level-stuff.c"
<#


(module heap-o-rama (setup-low-level-stuff
		     gc-happened?
		     do-the-dance)

(import scheme chicken)

(use srfi-18)
(import foreign)


(define-foreign-variable gc_happened bool)

(define setup-low-level-stuff
  (let ((setup (foreign-lambda void "setup_low_level_stuff" int int)))
    (lambda (mi ma)
      (setup mi ma)
      (set! gc_happened #f))))

(define find-children
  (foreign-lambda void "find_children" scheme-object scheme-object int))

(define (gc-happened?) gc_happened)

(define (do-the-dance count protos)
  (let* ((object-table (make-vector count))
	 (n (##sys#filter-heap-objects
	     (foreign-value "filter_func" c-pointer)
	     object-table
	     protos)))
    (when (negative? n) (set! n count))
    (let ((child-table (make-vector n '#())))
      (do ((i 0 (fx+ i 1)))
	  ((fx>= i n))
	(let ((x (vector-ref object-table i)))
	  (when (and (not (##sys#immediate? x)) 
		     (not (##core#inline "C_byteblockp" x)))
	    (vector-set! child-table i (make-vector (fx+ 1 (##sys#size x)) 0)))))
      (find-children object-table child-table n)
      (set! gc_happened #f)
      (values object-table child-table n))))

)