[gambit-list] Allocating structures from C

Christian christian at pflanze.mine.nu
Sun Nov 5 12:36:00 EST 2006


Hello

I'm trying to allocate scheme structures/records from C (without
calling back to scheme). It's "basically" working but segfaults in the
gc. What am I doing wrong?

Thanks
Christian.


(declare (block)
	 (standard-bindings)
	 (extended-bindings))

(define-structure scheme-error code)

(c-declare "
static ___SCMOBJ scheme_error_tag;

#include <stdio.h>

static
___SCMOBJ
scheme_error(___SCMOBJ code) {
   ___SCMOBJ res= ___alloc_scmobj(___sSTRUCTURE, 3<<___LWS, ___STILL);
   if (___FIXNUMP(res)) {
       // alloc error
       printf(\"alloc error\\n\");
       return ___FAL;
   } else {
       ___WORD*p= (___WORD*)___BODY(res);
       p[0]= scheme_error_tag;
       p[1]= code;
       ___still_obj_refcount_dec(res);
       return res;
   }
}
")

(##c-code "scheme_error_tag=___ARG1;" (##vector-ref (make-scheme-error #f) 0))

(define call-scheme-error (c-lambda (scheme-object)
				    scheme-object
				    "scheme_error"))

#|
> (compile-file "mailing-allocfromc")
#t
> (load "mailing-allocfromc")
".../mailing-allocfromc.o1"
> (call-scheme-error 100)
#<scheme-error #2 code: 100>
> (define-macro (n-times* n proc)
  (let ((PROC (gensym))
        (N (gensym)))
    `((lambda (n proc)
        (let lp ((i 0)
                 (r #!void))
          (if (>= i n)
              r
              (lp (+ i 1)
                  (proc i)))))
      ,n ,proc)))
> (n-times* 1 call-scheme-error)
#<scheme-error #3 code: 0>
> (n-times* 1 call-scheme-error)
#<scheme-error #4 code: 0>
> (n-times* 100 call-scheme-error)
#<scheme-error #5 code: 99>
> (n-times* 100000 call-scheme-error)

Program received signal SIGSEGV, Segmentation fault.
[Switching to Thread -1214988160 (LWP 15668)]
mark_array (start=0x8253b98, n=1) at mem.c:1750
1750	          head = body[-1];
(gdb) bt
#0  mark_array (start=0x8253b98, n=1) at mem.c:1750
#1  0xb7cd65a1 in scan (body=0x8253b90) at mem.c:2254
#2  0xb7cd661f in scan_still_objs_to_scan () at mem.c:2290
#3  0xb7cd7620 in ___garbage_collect (nonmovable_words_needed=0) at mem.c:3626
#4  0xb7cefd67 in ___H__20___kernel (___ps=0xb7f5c320) at _kernel.c:7301
#5  0xb7cd42db in ___call (nargs=0, proc=-1209590511, stack_marker=136566237) at setup.c:1779
#6  0xb7cd527e in ___setup (setup_params=0x0) at setup.c:2909
#7  0xb7cd29c8 in ___main (linker=0xa0a2928) at main.c:557
#8  0xb7cdd4a9 in ___main_char (argc=6, argv=0xa0a2928, linker=0xa0a2928, 
    script_line=0xa0a2928 <Address 0xa0a2928 out of bounds>) at os_base.c:240
#9  0x0816207f in main ()
(gdb)

|#




More information about the Gambit-list mailing list