[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