WIP

runtime.h

@@ -446,7 +446,7 @@ static void add_to_write_barrier(object obj) {
 #define transp_write_barrier() { \
   list l = write_barrier; \
   for (; !nullp(l); l = cdr(l)) { \
-    printf("transp from WB: %d", type_of(car(l))); \
+    printf("transp from WB: %ld", type_of(car(l))); \
     transp(car(l)); \
   } \
 }
@@ -646,6 +646,7 @@ static object Cyc_write(x) object x;
 {object tmp = nil;
  if (nullp(x)) {printf("()\n"); return x;}
  if (obj_is_char(x)) {printf("#\\%c\n", obj_obj2char(x)); return x;}
+ printf("[DEBUG: %p]", x); // DEBUGGING LINE!!
  switch (type_of(x))
    {case string_tag:
       printf("\"%s\"", ((string_type *) x)->str);
@@ -795,13 +796,13 @@ static object Cyc_eq(object x, object y) {
 }
 
 static object Cyc_set_car(object l, object val) {
-    add_to_write_barrier(val);
+    //add_to_write_barrier(val);
     ((list)l)->cons_car = val;
     return l;
 }
 
 static object Cyc_set_cdr(object l, object val) {
-    add_to_write_barrier(val);
+    //add_to_write_barrier(val);
     ((list)l)->cons_cdr = val;
     return l;
 }

test.scm

@@ -18,7 +18,19 @@
 ;;(eval '(call write 1))
 ;;(eval '(call mywrite 1))
 ;
-(eval '(define (a x) x))
+;(eval '(define (a x) x))
-(eval '(a 1))
+;(eval '(a 1))
-(eval '(a 1))
+;(eval '(a 1))
-(eval '(begin (define (a z) z) (a 1) (a 1)))
+;(eval '(begin (define (a z) z) (a 1) (a 1)))
+
+(define test '(a b))
+(set-car! test '(1 2 3))
+(write test)
+(define (loop n)
+  (cond
+    ((= n 10000)
+     (write test)
+     (loop 0))
+    (else
+      (loop (+ n 1)))))
+(loop 0)