[Chicken-users] Some allocation and object-passing tests

[Category 5]

I've written a small test program to try out the various means of
passing Scheme objects safely through a chain of C calls.  It defines: 

- a C function called dispatcher() that takes a function pointer and an
  arbitrary data pointer and simply calls the function repeatedly with
  the data pointer;

- two Scheme procedures defined with define-external suitable for
  passing to dispatcher(), both of which convert their data-pointer
  argument to a Scheme procedure and then call it;

- three foreign callback procedures:

  (dispatcher-malloc <thunk>)
  (dispatcher-alloc-in-heap <thunk>)
  (dispatcher-gc-protect <thunk>)

  Each of these either allocates a new closure object, copying the
  closure passed as <thunk>, or GC-protects the original <thunk> so it
  doesn't get moved around by the GC, thus invalidating the pointer to
  it passed to the define-externals that want to call it.

My results with Chicken 1.22 on NetBSD/sparc64 1.6R/gcc 2.95.3:

Each test run individually (i.e. with no calls to the others in the
program) works.  In one case I saw the dispatcher-alloc-in-heap test
result in a core dump, but I could not repeat this on subsequent
compiles.  Apart from that, both the alloc-in-heap and gc-protect
methods seem to behave properly.  This is good, but unfortunately sheds
no light on why neither method works in my real code while the malloc
method works in all cases.  (Oh well - maybe the test code can at least
make an appearance in the manual somewhere as a useful example.  =)

Results were the same with both scheme_callback1 and scheme_callback2.

However, if a call to *either* of the first two dispatchers precedes a
call to dispatcher-gc-protect, the latter prints "it worked" once and
then dies with:

  out of memory - heap full while resizing - execution terminated

So something weird is going on.

As a side note, all the working tests were compiled without
optimisation.  Anything I compile with -O1, including the trivial
program (print "hello world"), immediately dumps core.  This is the real
reason behind my problems loading extension .so files on this platform,
because csi -setup compiles extensions with optimisation enabled.

It would be cool if people could try running these tests on other
platforms.  Here's the code:

------------------------------------------------------------------------
;; alloc-test -- Program to test allocating and passing of
;;               Scheme objects through C.  Written for
;;               CHICKEN 1.22.    11 Nov 2003 (Category 5)

(require 'lolevel)  ; for pointer->object

#>
#define TRIES  5
#define SCHEME_CALLBACK  scheme_callback1

int dispatcher(void (*fn)(unsigned char *), unsigned char *udata) {
  int i, n = TRIES;
  for (i = 0; i < n; i++)  {
    (*fn)(udata);
    sleep(1);
  }
  return(0);
}
<#

(define-external (scheme_callback1 ((c-pointer unsigned-char) udata))
  void
  (let ((p (pointer->object udata)))
    (gc)
    (assert (procedure? p) "assertion failed")
    (p)))
(define-external (scheme_callback2 (scheme-object udata))
  void
  (gc)
  (assert (procedure? udata) "assertion failed")
  (udata))

(define dispatcher-malloc
  (foreign-callback-lambda*
   int
   ((scheme-object obj))
   #<<EOF
   C_word *closure;

   closure    = (C_word *)malloc(2*sizeof(C_word));
   closure[0] = C_make_header(C_CLOSURE_TYPE, 1);
   closure[1] = C_block_item(obj, 0);

   return(dispatcher(SCHEME_CALLBACK, (unsigned char *)closure));
EOF
))

(define dispatcher-alloc-in-heap
  (foreign-callback-lambda*
   int
   ((scheme-object obj))
   #<<EOF
   C_word *closure;

   closure    = C_alloc_in_heap(2);
   closure[0] = C_make_header(C_CLOSURE_TYPE, 1);
   closure[1] = C_block_item(obj, 0);

   return(dispatcher(SCHEME_CALLBACK, (unsigned char *)closure));
EOF
))

(define dispatcher-gc-protect
  (foreign-callback-lambda*
   int
   ((scheme-object obj))
   #<<EOF
   int result;
   C_word *data[1];

   data[0] = &obj;
   C_gc_protect(data, 1);
   result = dispatcher(SCHEME_CALLBACK, (unsigned char *)obj);
   C_gc_unprotect(1);
   return(result);
EOF
))

(define handler (lambda () (print "it worked")))
(print "-- dispatcher-malloc")
(dispatcher-malloc handler)
(print "-- dispatcher-alloc-in-heap")
(dispatcher-alloc-in-heap handler)
(print "-- dispatcher-gc-protect")
(dispatcher-gc-protect handler)
(print "-- done")

------------------------------------------------------------------------

--