- gc during callbacks now works.

- system continuations are now maintained as part of the list in
  pcb->next_k.

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^

scheme/last-revision

@@ -1 +1 @@
-1603
+1604

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;

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)

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);

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;
+  ikptr sk = ik_unsafe_alloc(pcb, system_continuation_size);
-  pcb->next_k = 0;
+  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;
+  ikptr sk = ik_unsafe_alloc(pcb, system_continuation_size);
-  pcb->next_k = 0;
+  ref(sk, 0) = system_continuation_tag;
-  ikptr system_stack = pcb->system_stack;
+  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;
 }