diff --git a/lab/test-ffi.ss b/lab/test-ffi.ss index 008f036..f2bf42d 100644 --- a/lab/test-ffi.ss +++ b/lab/test-ffi.ss @@ -10,11 +10,17 @@ (define foradd1 ((make-callback 'sint32 '(sint32)) (trace-lambda add1 (n) + (printf "collecting ...\n") + (collect) + (printf "collecting done\n") (add1 n)))) (define foradd1^ ((make-callback 'sint32 '(sint32)) (lambda (n) + (printf "collecting ...\n") + (collect) + (printf "collecting done\n") (add1 n)))) (define-syntax assert^ diff --git a/scheme/last-revision b/scheme/last-revision index 74d36ca..a5e7f96 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1603 +1604 diff --git a/src/ikarus-collect.c b/src/ikarus-collect.c index cc181a0..645b2df 100644 --- a/src/ikarus-collect.c +++ b/src/ikarus-collect.c @@ -329,6 +329,7 @@ static ikptr add_object_proc(gc_t* gc, ikptr x); #endif static void collect_stack(gc_t*, ikptr top, ikptr base); +static void collect_locatives(gc_t*, callback_locative*); static void collect_loop(gc_t*); static void fix_weak_pointers(gc_t*); static void gc_add_tconcs(gc_t*); @@ -419,6 +420,7 @@ ik_collect(unsigned long int mem_req, ikpcb* pcb){ scan_dirty_pages(&gc); collect_stack(&gc, pcb->frame_pointer, pcb->frame_base - wordsize); + collect_locatives(&gc, pcb->callbacks); pcb->next_k = add_object(&gc, pcb->next_k, "next_k"); pcb->symbol_table = add_object(&gc, pcb->symbol_table, "symbol_table"); pcb->gensym_table = add_object(&gc, pcb->gensym_table, "gensym_table"); @@ -790,6 +792,13 @@ add_code_entry(gc_t* gc, ikptr entry){ } } +static void +collect_locatives(gc_t* gc, callback_locative* loc) { + while(loc) { + loc->data = add_object(gc, loc->data, "locative"); + loc = loc->next; + } +} #define DEBUG_STACK 0 @@ -1158,6 +1167,18 @@ add_object_proc(gc_t* gc, ikptr x) { #endif return y; } + else if(fst == system_continuation_tag) { + ikptr y = gc_alloc_new_data(system_continuation_size, gc) + vector_tag; + ikptr top = ref(x, disp_system_continuation_top - vector_tag); + ikptr next = ref(x, disp_system_continuation_next - vector_tag); + ref(x, -vector_tag) = forward_ptr; + ref(x, wordsize-vector_tag) = y; + ref(y, -vector_tag) = fst; + ref(y, disp_system_continuation_top - vector_tag) = top; + ref(y, disp_system_continuation_next - vector_tag) = + add_object(gc, next, "next_k"); + return y; + } else if(tagof(fst) == pair_tag){ /* tcbucket */ ikptr y = gc_alloc_new_ptr(tcbucket_size, gc) + vector_tag; diff --git a/src/ikarus-data.h b/src/ikarus-data.h index 3cb2adb..08e0237 100644 --- a/src/ikarus-data.h +++ b/src/ikarus-data.h @@ -355,6 +355,12 @@ ikptr ik_safe_alloc(ikpcb* pcb, int size); #define disp_continuation_next (3 * wordsize) #define continuation_size (4 * wordsize) +#define system_continuation_tag ((ikptr) 0x11F) +#define disp_system_continuation_top (1 * wordsize) +#define disp_system_continuation_next (2 * wordsize) +#define disp_system_continuation_unused (3 * wordsize) +#define system_continuation_size (4 * wordsize) + #define off_continuation_top (disp_continuation_top - vector_tag) #define off_continuation_size (disp_continuation_size - vector_tag) #define off_continuation_next (disp_continuation_next - vector_tag) diff --git a/src/ikarus-exec.c b/src/ikarus-exec.c index 934d046..ddf2ab0 100644 --- a/src/ikarus-exec.c +++ b/src/ikarus-exec.c @@ -30,6 +30,9 @@ ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr, ikptr argcount, ikptr cp){ ikptr next_k = pcb->next_k; while(next_k){ cont* k = (cont*)(long)(next_k - vector_tag); + if (k->tag == system_continuation_tag) { + break; + } ikptr top = k->top; ikptr rp = ref(top, 0); long int framesize = (long int) ref(rp, disp_frame_size); diff --git a/src/ikarus-ffi.c b/src/ikarus-ffi.c index 7eaac5e..d5d486d 100644 --- a/src/ikarus-ffi.c +++ b/src/ikarus-ffi.c @@ -211,10 +211,12 @@ ikptr ikrt_call_back(ikptr proc, ikpcb* pcb) { ikrt_seal_scheme_stack(pcb); - ikptr old_k = pcb->next_k; - pcb->next_k = 0; + ikptr sk = ik_unsafe_alloc(pcb, system_continuation_size); + ref(sk, 0) = system_continuation_tag; + ref(sk, disp_system_continuation_top) = pcb->system_stack; + ref(sk, disp_system_continuation_next) = pcb->next_k; + pcb->next_k = sk + vector_tag; ikptr entry_point = ref(proc, off_closure_code); - ikptr system_stack = pcb->system_stack; #ifdef DEBUG_FFI fprintf(stderr, "system_stack = 0x%016lx\n", pcb->system_stack); #endif @@ -227,12 +229,18 @@ ikrt_call_back(ikptr proc, ikpcb* pcb) { #ifdef DEBUG_FFI fprintf(stderr, "rv=0x%016lx\n", rv); #endif - pcb->next_k = old_k; + sk = pcb->next_k - vector_tag; + if (ref(sk, 0) != system_continuation_tag) { + fprintf(stderr, "ikarus internal error: invalid system cont\n"); + exit(-1); + } + pcb->next_k = ref(sk, disp_system_continuation_next); + ref(sk, disp_system_continuation_next) = pcb->next_k; + pcb->system_stack = ref(sk, disp_system_continuation_top); pcb->frame_pointer = pcb->frame_base - wordsize; #ifdef DEBUG_FFI fprintf(stderr, "rp=0x%016lx\n", ref(pcb->frame_pointer, 0)); #endif - pcb->system_stack = system_stack; return rv; } @@ -242,9 +250,12 @@ ikptr ikrt_ffi_call(ikptr data, ikptr argsvec, ikpcb* pcb) { ikrt_seal_scheme_stack(pcb); - ikptr old_k = pcb->next_k; - pcb->next_k = 0; - ikptr system_stack = pcb->system_stack; + ikptr sk = ik_unsafe_alloc(pcb, system_continuation_size); + ref(sk, 0) = system_continuation_tag; + ref(sk, disp_system_continuation_top) = pcb->system_stack; + ref(sk, disp_system_continuation_next) = pcb->next_k; + pcb->next_k = sk + vector_tag; + ikptr cifptr = ref(data, off_vector_data + 0 * wordsize); ikptr funptr = ref(data, off_vector_data + 1 * wordsize); @@ -272,9 +283,17 @@ ikrt_ffi_call(ikptr data, ikptr argsvec, ikpcb* pcb) { #endif free(avalues); free(rvalue); + pcb->frame_pointer = pcb->frame_base - wordsize; - pcb->next_k = old_k; - pcb->system_stack = system_stack; + + sk = pcb->next_k - vector_tag; + if (ref(sk, 0) != system_continuation_tag) { + fprintf(stderr, "ikarus internal error: invalid system cont\n"); + exit(-1); + } + pcb->next_k = ref(sk, disp_system_continuation_next); + pcb->system_stack = ref(sk, disp_system_continuation_top); + return val; } @@ -315,28 +334,15 @@ generic_callback(ffi_cif *cif, void *ret, void **args, void *user_data){ ikptr rtype_conv = ref(data, off_vector_data + 3 * wordsize); ikpcb* pcb = the_pcb; - ikptr old_system_stack = pcb->system_stack; /* preserve */ - ikptr old_next_k = pcb->next_k; /* preserve */ - pcb->next_k = 0; ikptr code_entry = ref(proc, off_closure_code); ikptr code_ptr = code_entry - off_code_data; - ikptr frame_pointer = pcb->frame_pointer; - ikptr frame_base = pcb->frame_base; - /* - if ((frame_base - wordsize) != frame_pointer) { - fprintf(stderr, "ikarus internal error: INVALID FRAME LAYOUT 0x%016lx .. 0x%016lx\n", - frame_base, frame_pointer); - exit(-1); - } - */ + pcb->frame_pointer = pcb->frame_base; ref(pcb->frame_pointer, -2*wordsize) = fix(*((int*)args[0])); ikptr rv = ik_exec_code(pcb, code_ptr, fix(-1), proc); #ifdef DEBUG_FFI fprintf(stderr, "and back with rv=0x%016lx!\n", rv); #endif - pcb->system_stack = old_system_stack; - pcb->next_k = old_next_k; *((ikptr*)ret) = unfix(rv); return; }