(module cbtest ()

(import scheme)
(import chicken.base)
(import chicken.string)
(import chicken.format)
(import chicken.foreign)
(import chicken.memory)
(import chicken.memory.representation)

(import dyn-vector)
(import object-evict)

(define object->address (compose pointer->address object->pointer))
(define address->object (compose pointer->object address->pointer))

(define cb-vec (make-dynvector 16 #f)) 
(define-external cb_vec scheme-object (record-instance-slot cb-vec 0))

(define (register-cb! fn . args) 
  (let* ((i (dynvector-index not cb-vec))
         (argp (object->address (object-evict args))))
        (dynvector-set! cb-vec
                        (or i (dynvector-length cb-vec))
                        `(,fn . ,argp))))

(define cb-wrapper (foreign-safe-lambda* void ((c-pointer i)) #<<EOM
  C_word f_a = C_block_item(cb_vec, *(int *)i);
  C_save(C_u_i_cdr(f_a));
  C_callback(C_u_i_car(f_a), 1);
EOM
))

(define (testfn argp)
  (printf "maztest: ~S\n" (car (address->object argp))))

(define (main)
  (register-cb! testfn "hi")

  (let-location ((i int 0)) 
                (cb-wrapper #$i))

  (exit 0))

(main)

)

; alice@bellona:~/work/misc/cbtest % pontiff run
; running cbtest...
; maztest: "hi"