Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2015-03-08 16:51:53 -04:00
parent abb56c5795
commit 8063fc61c0
2 changed files with 20 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
runtime.h
View file

@ -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;
}

20
test.scm
View file

@ -18,7 +18,19 @@
;;(eval '(call write 1))
;;(eval '(call mywrite 1))
;
(eval '(define (a x) x))
(eval '(a 1))
(eval '(a 1))
(eval '(begin (define (a z) z) (a 1) (a 1)))
;(eval '(define (a x) x))
;(eval '(a 1))
;(eval '(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)