WIP

include/cyclone/types.h

@@ -403,6 +403,7 @@ void gc_wait_handshake();
 void gc_start_collector();
 void gc_mutator_thread_blocked(gc_thread_data * thd, object cont);
 void gc_mutator_thread_runnable(gc_thread_data * thd, object result, object maybe_copied);
+void Cyc_make_shared_object(void *data, object k, object obj);
 #define set_thread_blocked(d, c) \
   gc_mutator_thread_blocked(((gc_thread_data *)d), (c))
 /**

libs/cyclone/atomics.scm

@@ -76,6 +76,9 @@
         (apply swap! atom f args) ;; Value changed, try again
         )))
 
+(define-c make-shared
+  "(void *data, int argc, closure _, object k, object obj)"
+  " Cyc_make_shared_object(data, k, obj); ")
 ;; TODO: (make-shared obj)
 ;; likely implemented in runtime.c, either needs obj to be an immedate or 
 ;; an obj without children we can move to the heap or
@@ -119,3 +122,6 @@
     (compare-and-set! a lis 1)
     (ref a)
 ))
+(newline)
+(write
+  (make-shared '(1 (2))))

runtime.c

@@ -5684,6 +5684,7 @@ void GC(void *data, closure cont, object * args, int num_args)
 
 void Cyc_make_shared_object(void *data, object k, object obj)
 {
+  object buf[1];
   if (!is_object_type(obj) || // Immediates do not have to be moved
       gc_is_stack_obj(data, obj)) { // Not thread-local, assume already on heap
     return_closcall1(data, k, obj);
@@ -5695,30 +5696,27 @@ void Cyc_make_shared_object(void *data, object k, object obj)
   //  mutex_tag       = 14
   //  atomic_tag      = 22
   //  boolean_tag     = 0
+  //  bignum_tag      = 12
+  //  symbol_tag      = 19
+  //  closure0_tag    = 3
+  //  eof_tag         = 9
+  //  macro_tag       = 13
   // These should never be on the stack
   //  Cvar_tag        = 7
-  TODO:
-      , bytevector_tag  = 1
-      , c_opaque_tag    = 2
-      , closure0_tag    = 3
-      , closure1_tag    = 4
-      , closureN_tag    = 5
-      , double_tag      = 8
-      , eof_tag         = 9
-      , forward_tag     = 10
-      , integer_tag     = 11
-      , bignum_tag      = 12
-      , macro_tag       = 13
-      , pair_tag        = 15
-      , port_tag        = 16 
-      , primitive_tag   = 17
-      , string_tag      = 18
-      , symbol_tag      = 19
-      , vector_tag      = 20
-      , complex_num_tag = 21
-  case pair_type:
-  case vector_type:
-    // TODO: must initiate minor GC, how to ensure we return new ref to obj?
+//  TODO:
+//      , bytevector_tag  = 1
+//      , c_opaque_tag    = 2
+//      , closure1_tag    = 4
+//      , closureN_tag    = 5
+//      , double_tag      = 8
+//      , port_tag        = 16 
+//      , primitive_tag   = 17
+//      , string_tag      = 18
+//      , complex_num_tag = 21
+  case pair_tag:
+  case vector_tag:
+    buf[0] = obj;
+    GC(data, k, buf, 1); // Ensure whole obj is relocated to heap
     break;
   default:
     printf("Invalid shared object type %d\n", type_of(obj));