Welcome to the CHICKEN Scheme pasting service

(use srfi-1)
#>
void FOO1(C_word cb)
{
 C_callback (cb, 0);
}
// Foo2 randomly produces:
//; Error: call of non-procedure: #<invalid forwarded object>
//; or segfaults,
void FOO2(C_word cb)
{
 C_callback (cb, 0);
 C_callback (cb, 0);
}
<#

(define FOO1 (foreign-safe-lambda void "FOO1" scheme-object))
(define FOO2 (foreign-safe-lambda void "FOO2" scheme-object))

;; called with C_callback
(define check-proc-callback (lambda args (if (null? args) #f #t)))

;; works fine:
(define (run-test1) 
  (for-each (lambda _ (FOO1 check-proc-callback))
            (iota 100000)))
(define (run-test2) 
  (for-each (lambda _ (FOO2 check-proc-callback))
            (iota 100000)))


(print "test 1")
(run-test1)
(print "test 2-bad")
(run-test2)

(print "compiled tests ok (not!)")



/tmp $ csc bad.scm && ./bad
test 1
test 2-bad
segmentation fault

;; This seems to solve the problem above


;; callback used by our C-function. It returns itself, thus, the
;; result of C_callback is the callback function itself -
;; this is useful because sometimes this callback-function
;; is moved by the GC! So the original callback would point
;; to the old location and be invalid.
(define (callback-wrapper proc)
  (let* ([self #f]
         [cbwrap (lambda (cp-pointer) ; coming from C-land
                   (proc cp-pointer)
                   self)])
    (set! self cbwrap)
    cbwrap))

(define (cp:for-each/shape space callback) 
  ((foreign-safe-lambda void "forEachShape" (c-pointer "cpSpace") scheme-object)
   space (callback-wrapper callback)))

// oh yeah, and the C-part

void cbSpaceEachPointerCallback(void *pointer, /*body,shape,contraint*/
                                C_word *data /*callback closure*/)
{
 C_word *ptr = C_alloc (C_SIZEOF_POINTER);
  C_word sp = C_mpointer (&ptr, pointer);
  C_word old = *data;
  C_save (sp);
  *data = C_callback(*data, 1);
  //printf ("old = %X\tnew = %X\n", old, *data);
}
void forEachShape (cpSpace *space, C_word callback) {
 cpSpaceEachShape (space, cbSpaceEachPointerCallback, &callback);
}