From 3b932ebfc5a46194583bad4c3c22995df4ff3178 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Feb 2017 18:27:48 -0500 Subject: [PATCH 01/20] WIP --- gc.c | 7 +++++++ include/cyclone/types.h | 2 ++ runtime.c | 1 + scheme/base.sld | 1 + 4 files changed, 11 insertions(+) diff --git a/gc.c b/gc.c index 502cc4c5..e45ec057 100644 --- a/gc.c +++ b/gc.c @@ -1307,6 +1307,12 @@ void gc_mut_cooperate(gc_thread_data * thd, int buf_len) if (thd->scm_thread_obj) { gc_mark_gray(thd, thd->scm_thread_obj); } + if (thd->exception_handler_stack) { + gc_mark_gray(thd, thd->exception_handler_stack); + } + if (thd->param_objs) { + gc_mark_gray(thd, thd->param_objs); + } // Also, mark everything the collector moved to the heap for (i = 0; i < buf_len; i++) { gc_mark_gray(thd, thd->moveBuf[i]); @@ -1883,6 +1889,7 @@ void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base, thd->mutation_count = 0; thd->mutations = vpbuffer_realloc(thd->mutations, &(thd->mutation_buflen)); + thd->param_objs = NULL; thd->exception_handler_stack = NULL; thd->scm_thread_obj = NULL; thd->thread_state = CYC_THREAD_STATE_NEW; diff --git a/include/cyclone/types.h b/include/cyclone/types.h index b27d99c0..5e81145f 100644 --- a/include/cyclone/types.h +++ b/include/cyclone/types.h @@ -294,6 +294,8 @@ struct gc_thread_data_t { char *stack_prev_frame; // Exception handler stack object exception_handler_stack; + // Parameter object data + object *param_objs; }; /* GC prototypes */ diff --git a/runtime.c b/runtime.c index b9f99882..bd811299 100644 --- a/runtime.c +++ b/runtime.c @@ -4776,6 +4776,7 @@ int gc_minor(void *data, object low_limit, object high_limit, closure cont, // Transport exception stack gc_move2heap(((gc_thread_data *) data)->exception_handler_stack); + gc_move2heap(((gc_thread_data *) data)->param_objs); gc_move2heap(((gc_thread_data *) data)->scm_thread_obj); // Transport mutations diff --git a/scheme/base.sld b/scheme/base.sld index 7db66cec..292f0a5e 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -949,6 +949,7 @@ ((param value) ...) body)))) (define (make-parameter init . o) + ;; TODO: need to store/set value in the thread data parameter (param_objs), to make it thread-specific (let* ((converter (if (pair? o) (car o) (lambda (x) x))) (value (converter init))) From c826f09341656997e6f1b67aba5e958b6db9ff9b Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Feb 2017 18:45:23 -0500 Subject: [PATCH 02/20] Added TODO --- scheme/base.sld | 1 + 1 file changed, 1 insertion(+) diff --git a/scheme/base.sld b/scheme/base.sld index 292f0a5e..fdf892fa 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -950,6 +950,7 @@ body)))) (define (make-parameter init . o) ;; TODO: need to store/set value in the thread data parameter (param_objs), to make it thread-specific + ;; TODO: what will the key be? how do we look up the thread's value for this parameter object???? (let* ((converter (if (pair? o) (car o) (lambda (x) x))) (value (converter init))) From a714f57f975d4d33299a958f2142c3cbf811a53d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 1 Mar 2017 18:24:45 -0500 Subject: [PATCH 03/20] Added Cyc_is_fixnum --- include/cyclone/runtime.h | 2 ++ runtime.c | 7 +++++++ 2 files changed, 9 insertions(+) diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index d575e26e..5511f941 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -73,6 +73,7 @@ void gc_init_heap(long heap_size); #define Cyc_check_pair(d,obj) Cyc_check_type(d,Cyc_is_pair, pair_tag, obj); #define Cyc_check_proc(d,obj) Cyc_check_type2(d,Cyc_is_procedure, closureN_tag, obj); #define Cyc_check_num(d,obj) Cyc_check_type(d,Cyc_is_number, integer_tag, obj); +#define Cyc_check_fixnum(d,obj) Cyc_check_type(d,Cyc_is_fixnum, integer_tag, obj); #define Cyc_check_int(d,obj) Cyc_check_type(d,Cyc_is_integer, integer_tag, obj); #define Cyc_check_str(d,obj) Cyc_check_type(d,Cyc_is_string, string_tag, obj); #define Cyc_check_sym(d,obj) Cyc_check_type(d,Cyc_is_symbol, symbol_tag, obj); @@ -359,6 +360,7 @@ object Cyc_is_null(object o); object Cyc_is_number(object o); object Cyc_is_real(object o); object Cyc_is_integer(object o); +object Cyc_is_fixnum(object o); object Cyc_is_bignum(object o); object Cyc_is_vector(object o); object Cyc_is_bytevector(object o); diff --git a/runtime.c b/runtime.c index bd811299..f73eefc9 100644 --- a/runtime.c +++ b/runtime.c @@ -1465,6 +1465,13 @@ object Cyc_is_real(object o) return Cyc_is_number(o); } +object Cyc_is_fixnum(object o) +{ + if (obj_is_int(o)) + return boolean_t; + return boolean_f; +} + object Cyc_is_integer(object o) { if ((o != NULL) && (obj_is_int(o) || From 28aa84c52d93586a0571930568c2d5e5a17090af Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 1 Mar 2017 18:59:19 -0500 Subject: [PATCH 04/20] WIP --- atomics.sld | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 atomics.sld diff --git a/atomics.sld b/atomics.sld new file mode 100644 index 00000000..f26b74fe --- /dev/null +++ b/atomics.sld @@ -0,0 +1,15 @@ +(define-library (atomics) + (export + atomic:get-fx + atomic:fx++ + ) + (include-c-header "") + (begin + ;TODO: needed, unfortunately (define tmp 1) + (define-c atomic:fx++ + "(void *data, int argc, closure _, object k, object num)" + " Cyc_check_fixnum(data, num); + ck_pr_add_ptr(&num, 2); + return_closcall1(data, k, num); ") + )) + From 69468b14808bc927c4f23b8d22bb462f6de45f52 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 2 Mar 2017 20:31:29 -0500 Subject: [PATCH 05/20] WIP --- atomics.sld | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/atomics.sld b/atomics.sld index f26b74fe..573cf896 100644 --- a/atomics.sld +++ b/atomics.sld @@ -1,15 +1,15 @@ (define-library (atomics) (export - atomic:get-fx - atomic:fx++ + atomic:get + atomic:set! ) (include-c-header "") (begin - ;TODO: needed, unfortunately (define tmp 1) - (define-c atomic:fx++ - "(void *data, int argc, closure _, object k, object num)" - " Cyc_check_fixnum(data, num); - ck_pr_add_ptr(&num, 2); - return_closcall1(data, k, num); ") + ;TODO: won't work, ints are immutable + ;(define-c atomic:fx++ + ; "(void *data, int argc, closure _, object k, object num)" + ; " Cyc_check_fixnum(data, num); + ; ck_pr_add_ptr(&num, 2); + ; return_closcall1(data, k, num); ") )) From 0c4be522e56342caae5a8418af74c9ecb267743f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 2 Mar 2017 23:40:44 -0500 Subject: [PATCH 06/20] Use *parameter-id* in make-parameter --- scheme/base.sld | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/scheme/base.sld b/scheme/base.sld index fdf892fa..72af0d83 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -948,12 +948,18 @@ () ((param value) ...) body)))) + (define *parameter-id* 0) (define (make-parameter init . o) ;; TODO: need to store/set value in the thread data parameter (param_objs), to make it thread-specific - ;; TODO: what will the key be? how do we look up the thread's value for this parameter object???? (let* ((converter (if (pair? o) (car o) (lambda (x) x))) - (value (converter init))) + (value (converter init)) + (key #f)) + ;; TODO: this is not thread safe! + (set! key *parameter-id*) + (set! *parameter-id* (+ *parameter-id* 1)) + ;; + (lambda args (cond ((null? args) From 609395886aebd0e6b7118e8a6caf5d7f787f92fb Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 2 Mar 2017 19:06:38 -0500 Subject: [PATCH 07/20] WIP --- scheme/base.sld | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/scheme/base.sld b/scheme/base.sld index 72af0d83..95ee2deb 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -107,6 +107,7 @@ string->vector string-map string-for-each + get-param-objs ;; TODO: only for debugging!! make-parameter current-output-port current-input-port @@ -948,6 +949,17 @@ () ((param value) ...) body)))) + (define-c get-param-objs + "(void *data, int argc, closure _, object k)" + " gc_thread_data *thd = (gc_thread_data *)data; + return_closcall1(data, k, thd->param_objs); ") + (define-c set-param-obj! + "(void *data, int argc, closure _, object k, object obj)" + " make_pair(p, obj, NULL); + gc_thread_data *thd = (gc_thread_data *)data; + cdr(&p) = thd->param_objs; + thd->param_objs = (object)(&p); + return_closcall1(data, k, thd->param_objs); ") (define *parameter-id* 0) (define (make-parameter init . o) ;; TODO: need to store/set value in the thread data parameter (param_objs), to make it thread-specific @@ -959,18 +971,24 @@ (set! key *parameter-id*) (set! *parameter-id* (+ *parameter-id* 1)) ;; + (set-param-obj! (cons key value)) (lambda args (cond ((null? args) - value) + (cdr (assoc key (get-param-objs)))) + ;value) ((eq? (car args) ') - (set! value (cadr args))) + (let ((cell (assoc key (get-param-objs)))) + (set-cdr! cell (cadr args)))) + ;(set! value (cadr args))) ((eq? (car args) ') converter) (else ;(error "bad parameter syntax" args) - (set! value (converter (car args))) + (let ((cell (assoc key (get-param-objs)))) + (set-cdr! cell (converter (car args)))) + ;(set! value (converter (car args))) ))))) (define current-output-port (make-parameter (Cyc-stdout))) From 1d5cd9c626bb4afded88e7d2a48e1c9fb7b07e13 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sun, 12 Mar 2017 23:01:08 +0000 Subject: [PATCH 08/20] TODO for loading param_objs on thread spawn --- runtime.c | 11 +++++++++++ scheme/base.sld | 1 - 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/runtime.c b/runtime.c index f73eefc9..2cb36a4e 100644 --- a/runtime.c +++ b/runtime.c @@ -5340,6 +5340,17 @@ void *Cyc_init_thread(object thread_and_thunk) thd->gc_num_args = 1; thd->gc_args[0] = &Cyc_91end_91thread_67_primitive; thd->thread_id = pthread_self(); + +// TODO: want to get thread params from calling thread, and probably +// allocate a new set of cells instead of just assigning this thread's +// params to the parent's params. + + vector_type *t = (vector_type *)thd->scm_thread_obj; + object op = Cyc_vector_ref(thd, t, obj_int2obj(2)); + c_opaque_type *o = (c_opaque_type *)op; +// thd->param_objs = ?? +// END TODO + gc_add_mutator(thd); ck_pr_cas_int((int *)&(thd->thread_state), CYC_THREAD_STATE_NEW, CYC_THREAD_STATE_RUNNABLE); diff --git a/scheme/base.sld b/scheme/base.sld index 95ee2deb..d046b8f8 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -962,7 +962,6 @@ return_closcall1(data, k, thd->param_objs); ") (define *parameter-id* 0) (define (make-parameter init . o) - ;; TODO: need to store/set value in the thread data parameter (param_objs), to make it thread-specific (let* ((converter (if (pair? o) (car o) (lambda (x) x))) (value (converter init)) From a964bb17ae47fafbf4368a0766abe7b31201e96a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 13 Mar 2017 12:15:43 +0000 Subject: [PATCH 09/20] WIP --- runtime.c | 12 ++++++++---- srfi/18.sld | 2 ++ 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/runtime.c b/runtime.c index 2cb36a4e..bee3855f 100644 --- a/runtime.c +++ b/runtime.c @@ -5341,14 +5341,18 @@ void *Cyc_init_thread(object thread_and_thunk) thd->gc_args[0] = &Cyc_91end_91thread_67_primitive; thd->thread_id = pthread_self(); -// TODO: want to get thread params from calling thread, and probably -// allocate a new set of cells instead of just assigning this thread's -// params to the parent's params. - + TODO: want to get thread params from calling thread, and probably + allocate a new set of cells instead of just assigning this thread's + params to the parent's params. + vector_type *t = (vector_type *)thd->scm_thread_obj; object op = Cyc_vector_ref(thd, t, obj_int2obj(2)); c_opaque_type *o = (c_opaque_type *)op; // thd->param_objs = ?? + object obj = ((gc_thread_data *)o->ptr)->param_objs; + while (obj) { + + } // END TODO gc_add_mutator(thd); diff --git a/srfi/18.sld b/srfi/18.sld index 7353a0c9..43ebc45e 100644 --- a/srfi/18.sld +++ b/srfi/18.sld @@ -99,6 +99,8 @@ (thread-params (cons t (lambda () (vector-set! t 2 (%get-thread-data)) (thunk))))) + (vector-set! t 2 (%get-thread-data)) ;; Temporarily make parent thread + ;; data available for child init (Cyc-minor-gc) (Cyc-spawn-thread! thread-params) )) From 6742142b9d59fa8035ef60f0113c809a6899ccb7 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 13 Mar 2017 22:55:18 +0000 Subject: [PATCH 10/20] Issue #109 - Copy parent thread's params when spinning up a new thread. --- examples/threading/parameters.scm | 12 ++++++--- runtime.c | 45 ++++++++++++++++++++++++++----- 2 files changed, 47 insertions(+), 10 deletions(-) diff --git a/examples/threading/parameters.scm b/examples/threading/parameters.scm index 7221cae8..7c5f83fa 100644 --- a/examples/threading/parameters.scm +++ b/examples/threading/parameters.scm @@ -1,4 +1,8 @@ ;; A simple program demonstrating how parameter objects interact with threads +;; +;; Note this is poor code as it uses timing via sleeps instead of proper +;; thread synchronization!!! +;; (import (scheme base) (scheme read) (scheme write) @@ -8,18 +12,20 @@ (thread-start! (make-thread (lambda () - (thread-sleep! 1000) + (thread-sleep! 2000) (display "started thread, this should be written to console") (newline) (display "thread done") - (newline)))) + (newline) + (flush-output-port (current-output-port))))) +(thread-sleep! 1000) ;; Prevent race condition replacing stdout before thread is spawned (write `(1 2 3)) (define fp (open-output-file "tmp.txt")) (parameterize ((current-output-port fp)) (write `(4 5 6)) - (thread-sleep! 5000) + (thread-sleep! 3000) ) (close-port fp) (write `(7 8 9)) diff --git a/runtime.c b/runtime.c index bee3855f..b3dd7abc 100644 --- a/runtime.c +++ b/runtime.c @@ -5326,6 +5326,21 @@ const object primitive_Cyc_91write = &Cyc_91write_primitive; const object primitive_Cyc_91display = &Cyc_91display_primitive; const object primitive_call_95cc = &call_95cc_primitive; +void *gc_alloc_pair(gc_thread_data *data, object head, object tail) +{ + int heap_grown; + pair_type *p; + pair_type tmp; + tmp.hdr.mark = gc_color_red; + tmp.hdr.grayed = 0; + tmp.tag = pair_tag; + tmp.pair_car = head; + tmp.pair_cdr = tail; + p = gc_alloc(((gc_thread_data *)data)->heap, sizeof(pair_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown); + + return p; +} + /** * Thread initialization function only called from within the runtime */ @@ -5341,18 +5356,34 @@ void *Cyc_init_thread(object thread_and_thunk) thd->gc_args[0] = &Cyc_91end_91thread_67_primitive; thd->thread_id = pthread_self(); - TODO: want to get thread params from calling thread, and probably - allocate a new set of cells instead of just assigning this thread's - params to the parent's params. +// TODO: want to get thread params from calling thread, and probably +// allocate a new set of cells instead of just assigning this thread's +// params to the parent's params. vector_type *t = (vector_type *)thd->scm_thread_obj; object op = Cyc_vector_ref(thd, t, obj_int2obj(2)); c_opaque_type *o = (c_opaque_type *)op; -// thd->param_objs = ?? - object obj = ((gc_thread_data *)o->ptr)->param_objs; - while (obj) { - + object par = ((gc_thread_data *)o->ptr)->param_objs; + object child = NULL; + thd->param_objs = NULL; + while (par) { + if (thd->param_objs == NULL) { + thd->param_objs = gc_alloc_pair(thd, NULL, NULL); + child = thd->param_objs; + } else { + pair_type *p = gc_alloc_pair(thd, NULL, NULL); + cdr(child) = p; + child = p; + } + car(child) = gc_alloc_pair(thd, car(car(par)), cdr(car(par))); + par = cdr(par); } +// fprintf(stdout, "old: "); +// Cyc_display(thd, ((gc_thread_data *)o->ptr)->param_objs, stdout); +// fprintf(stdout, "\n"); +// fprintf(stdout, "new: "); +// Cyc_display(thd, thd->param_objs, stdout); +// fprintf(stdout, "\n"); // END TODO gc_add_mutator(thd); From dbe8597e904eb46cbcbbe3e6980c0ecbf3e1ecb8 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 14 Mar 2017 21:14:01 +0000 Subject: [PATCH 11/20] Cleanup --- examples/threading/parameters.scm | 2 +- runtime.c | 32 +++++++++++++------------------ 2 files changed, 14 insertions(+), 20 deletions(-) diff --git a/examples/threading/parameters.scm b/examples/threading/parameters.scm index 7c5f83fa..0fc9ed71 100644 --- a/examples/threading/parameters.scm +++ b/examples/threading/parameters.scm @@ -12,7 +12,7 @@ (thread-start! (make-thread (lambda () - (thread-sleep! 2000) + (thread-sleep! 1200) (display "started thread, this should be written to console") (newline) (display "thread done") diff --git a/runtime.c b/runtime.c index b3dd7abc..22f8eed2 100644 --- a/runtime.c +++ b/runtime.c @@ -5346,6 +5346,9 @@ void *gc_alloc_pair(gc_thread_data *data, object head, object tail) */ void *Cyc_init_thread(object thread_and_thunk) { + vector_type *t; + c_opaque_type *o; + object op, parent, child; long stack_start; gc_thread_data *thd; thd = malloc(sizeof(gc_thread_data)); @@ -5356,17 +5359,14 @@ void *Cyc_init_thread(object thread_and_thunk) thd->gc_args[0] = &Cyc_91end_91thread_67_primitive; thd->thread_id = pthread_self(); -// TODO: want to get thread params from calling thread, and probably -// allocate a new set of cells instead of just assigning this thread's -// params to the parent's params. - - vector_type *t = (vector_type *)thd->scm_thread_obj; - object op = Cyc_vector_ref(thd, t, obj_int2obj(2)); - c_opaque_type *o = (c_opaque_type *)op; - object par = ((gc_thread_data *)o->ptr)->param_objs; - object child = NULL; + // Copy thread params from the calling thread + t = (vector_type *)thd->scm_thread_obj; + op = Cyc_vector_ref(thd, t, obj_int2obj(2)); // Field set in thread-start! + o = (c_opaque_type *)op; + parent = ((gc_thread_data *)o->ptr)->param_objs; // Unbox parent thread's data + child = NULL; thd->param_objs = NULL; - while (par) { + while (parent) { if (thd->param_objs == NULL) { thd->param_objs = gc_alloc_pair(thd, NULL, NULL); child = thd->param_objs; @@ -5375,16 +5375,10 @@ void *Cyc_init_thread(object thread_and_thunk) cdr(child) = p; child = p; } - car(child) = gc_alloc_pair(thd, car(car(par)), cdr(car(par))); - par = cdr(par); + car(child) = gc_alloc_pair(thd, car(car(parent)), cdr(car(parent))); + parent = cdr(parent); } -// fprintf(stdout, "old: "); -// Cyc_display(thd, ((gc_thread_data *)o->ptr)->param_objs, stdout); -// fprintf(stdout, "\n"); -// fprintf(stdout, "new: "); -// Cyc_display(thd, thd->param_objs, stdout); -// fprintf(stdout, "\n"); -// END TODO + // Done initializing parameter objects gc_add_mutator(thd); ck_pr_cas_int((int *)&(thd->thread_state), CYC_THREAD_STATE_NEW, From 8efb71409712b81fd5c6e61586c56949035dcbe7 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 14 Mar 2017 22:59:45 +0000 Subject: [PATCH 12/20] WIP --- scheme/base.sld | 1 + 1 file changed, 1 insertion(+) diff --git a/scheme/base.sld b/scheme/base.sld index d046b8f8..bcdfa116 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -957,6 +957,7 @@ "(void *data, int argc, closure _, object k, object obj)" " make_pair(p, obj, NULL); gc_thread_data *thd = (gc_thread_data *)data; + //Cyc_global_set(thd, thd->param_objs, &p); // TODO: needed?? seems to be segfauling, though cdr(&p) = thd->param_objs; thd->param_objs = (object)(&p); return_closcall1(data, k, thd->param_objs); ") From b4a9d4ae423364b30fb12ddcd884f3f26a3b8608 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 15 Mar 2017 11:32:43 +0000 Subject: [PATCH 13/20] WIP, temporarily reverted set params --- scheme/base.sld | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/scheme/base.sld b/scheme/base.sld index bcdfa116..e3096b58 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -957,9 +957,9 @@ "(void *data, int argc, closure _, object k, object obj)" " make_pair(p, obj, NULL); gc_thread_data *thd = (gc_thread_data *)data; - //Cyc_global_set(thd, thd->param_objs, &p); // TODO: needed?? seems to be segfauling, though cdr(&p) = thd->param_objs; - thd->param_objs = (object)(&p); + global_set((thd->param_objs), &p); + //thd->param_objs = (object)(&p); return_closcall1(data, k, thd->param_objs); ") (define *parameter-id* 0) (define (make-parameter init . o) @@ -976,19 +976,19 @@ (lambda args (cond ((null? args) - (cdr (assoc key (get-param-objs)))) - ;value) + ;(cdr (assoc key (get-param-objs)))) + value) ((eq? (car args) ') - (let ((cell (assoc key (get-param-objs)))) - (set-cdr! cell (cadr args)))) - ;(set! value (cadr args))) + ;(let ((cell (assoc key (get-param-objs)))) + ; (set-cdr! cell (cadr args)))) + (set! value (cadr args))) ((eq? (car args) ') converter) (else ;(error "bad parameter syntax" args) - (let ((cell (assoc key (get-param-objs)))) - (set-cdr! cell (converter (car args)))) - ;(set! value (converter (car args))) + ;(let ((cell (assoc key (get-param-objs)))) + ; (set-cdr! cell (converter (car args)))) + (set! value (converter (car args))) ))))) (define current-output-port (make-parameter (Cyc-stdout))) From 5585b01ea5aa2d8c0e5bcf996795cd6186f70632 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 15 Mar 2017 16:49:12 +0000 Subject: [PATCH 14/20] Fixup type --- include/cyclone/types.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/cyclone/types.h b/include/cyclone/types.h index 5e81145f..f59f73e6 100644 --- a/include/cyclone/types.h +++ b/include/cyclone/types.h @@ -295,7 +295,7 @@ struct gc_thread_data_t { // Exception handler stack object exception_handler_stack; // Parameter object data - object *param_objs; + object param_objs; }; /* GC prototypes */ From 06dcb18ba2f0b1a2e776f459ff27deca0fd03e75 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 15 Mar 2017 17:28:54 +0000 Subject: [PATCH 15/20] WIP --- scheme/base.sld | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/scheme/base.sld b/scheme/base.sld index e3096b58..9f93a48d 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -952,15 +952,20 @@ (define-c get-param-objs "(void *data, int argc, closure _, object k)" " gc_thread_data *thd = (gc_thread_data *)data; + //Cyc_st_add(data, \"scheme/base.sld:get-param-objs\"); return_closcall1(data, k, thd->param_objs); ") (define-c set-param-obj! "(void *data, int argc, closure _, object k, object obj)" - " make_pair(p, obj, NULL); + " make_pair(p, obj, ((gc_thread_data *)data)->param_objs); gc_thread_data *thd = (gc_thread_data *)data; - cdr(&p) = thd->param_objs; + //Cyc_st_add(data, \"scheme/base.sld:set-param-objs!\"); + //fprintf(stderr, \"scheme/base.sld:set-param-objs!\\n\"); global_set((thd->param_objs), &p); //thd->param_objs = (object)(&p); - return_closcall1(data, k, thd->param_objs); ") + // obj is on the stack, need to add it to write barrier + // to ensure it is transported to the heap + //add_mutation(data, &p, -1, obj); + return_closcall1(data, k, boolean_t); ") (define *parameter-id* 0) (define (make-parameter init . o) (let* ((converter @@ -976,19 +981,25 @@ (lambda args (cond ((null? args) + ;; DEBUG + (let ((pobj (get-param-objs))) + (if (not (pair? (car pobj))) + (Cyc-display `(get-param-objs not a list: ,(get-param-objs)))) + (cdr (assoc key pobj)))) + ;; END DEBUG ;(cdr (assoc key (get-param-objs)))) - value) + ;value) ((eq? (car args) ') - ;(let ((cell (assoc key (get-param-objs)))) - ; (set-cdr! cell (cadr args)))) - (set! value (cadr args))) + (let ((cell (assoc key (get-param-objs)))) + (set-cdr! cell (cadr args)))) + ;(set! value (cadr args))) ((eq? (car args) ') converter) (else ;(error "bad parameter syntax" args) - ;(let ((cell (assoc key (get-param-objs)))) - ; (set-cdr! cell (converter (car args)))) - (set! value (converter (car args))) + (let ((cell (assoc key (get-param-objs)))) + (set-cdr! cell (converter (car args)))) + ;(set! value (converter (car args))) ))))) (define current-output-port (make-parameter (Cyc-stdout))) From 3f75e8d231f3bafbe737c46f8d3777be97416f76 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 16 Mar 2017 14:07:36 +0000 Subject: [PATCH 16/20] Mark objects when collector cooperates When the collector cooperates for a mutator it needs to mark any heap-collected objects that are stored within the mutator's data object. This prevents problems where these objects (which are essentially per-thread global roots) are incorrectly collected. --- gc.c | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/gc.c b/gc.c index e45ec057..a77b2482 100644 --- a/gc.c +++ b/gc.c @@ -1696,6 +1696,15 @@ void gc_wait_handshake() //for (i = 0; i < m->gc_num_args; i++) { // gc_mark_gray(m, m->gc_args[i]); //} + if (m->scm_thread_obj) { + gc_mark_gray(m, m->scm_thread_obj); + } + if (m->exception_handler_stack) { + gc_mark_gray(m, m->exception_handler_stack); + } + if (m->param_objs) { + gc_mark_gray(m, m->param_objs); + } // Also, mark everything the collector moved to the heap for (i = 0; i < buf_len; i++) { gc_mark_gray(m, m->moveBuf[i]); From d8a11c2ea6d3a125e09976029ccfed8eb7697cc4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 16 Mar 2017 14:10:51 +0000 Subject: [PATCH 17/20] Clean up the code for (set-param-obj!) --- scheme/base.sld | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/scheme/base.sld b/scheme/base.sld index 9f93a48d..9ef17deb 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -956,16 +956,21 @@ return_closcall1(data, k, thd->param_objs); ") (define-c set-param-obj! "(void *data, int argc, closure _, object k, object obj)" - " make_pair(p, obj, ((gc_thread_data *)data)->param_objs); - gc_thread_data *thd = (gc_thread_data *)data; - //Cyc_st_add(data, \"scheme/base.sld:set-param-objs!\"); - //fprintf(stderr, \"scheme/base.sld:set-param-objs!\\n\"); - global_set((thd->param_objs), &p); - //thd->param_objs = (object)(&p); - // obj is on the stack, need to add it to write barrier - // to ensure it is transported to the heap - //add_mutation(data, &p, -1, obj); - return_closcall1(data, k, boolean_t); ") + " gc_thread_data *thd = (gc_thread_data *)data; + make_pair(c, obj, thd->param_objs); + thd->param_objs = &c; + return_closcall1(data, k, &c); ") + ;"(void *data, int argc, closure _, object k, object obj)" + ;" make_pair(p, obj, ((gc_thread_data *)data)->param_objs); + ; gc_thread_data *thd = (gc_thread_data *)data; + ; //Cyc_st_add(data, \"scheme/base.sld:set-param-objs!\"); + ; //fprintf(stderr, \"scheme/base.sld:set-param-objs!\\n\"); + ; global_set((thd->param_objs), &p); + ; //thd->param_objs = (object)(&p); + ; // obj is on the stack, need to add it to write barrier + ; // to ensure it is transported to the heap + ; //add_mutation(data, &p, -1, obj); + ; return_closcall1(data, k, boolean_t); ") (define *parameter-id* 0) (define (make-parameter init . o) (let* ((converter From d86b91af36e93b44c2df825750adeb607e49b52d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 16 Mar 2017 14:11:46 +0000 Subject: [PATCH 18/20] Remove debug code --- scheme/base.sld | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scheme/base.sld b/scheme/base.sld index 9ef17deb..b9b026b9 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -988,8 +988,8 @@ ((null? args) ;; DEBUG (let ((pobj (get-param-objs))) - (if (not (pair? (car pobj))) - (Cyc-display `(get-param-objs not a list: ,(get-param-objs)))) + ;(if (not (pair? (car pobj))) + ; (Cyc-display `(get-param-objs not a list: ,(get-param-objs)))) (cdr (assoc key pobj)))) ;; END DEBUG ;(cdr (assoc key (get-param-objs)))) From bb6d822d92f214cda434ac391f40a7473387ca84 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 16 Mar 2017 15:58:17 +0000 Subject: [PATCH 19/20] Do not export internal get function --- scheme/base.sld | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scheme/base.sld b/scheme/base.sld index b9b026b9..f3ab3e8c 100644 --- a/scheme/base.sld +++ b/scheme/base.sld @@ -107,7 +107,7 @@ string->vector string-map string-for-each - get-param-objs ;; TODO: only for debugging!! + ;get-param-objs ;; TODO: only for debugging!! make-parameter current-output-port current-input-port From 596869f0e0a5c03773f0827938c93311468f2181 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 16 Mar 2017 17:27:27 +0000 Subject: [PATCH 20/20] Issue #182 - Misc string->number fixes --- runtime.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/runtime.c b/runtime.c index 22f8eed2..dd7ebc4f 100644 --- a/runtime.c +++ b/runtime.c @@ -1840,6 +1840,8 @@ object Cyc_string2number2_(void *data, object cont, int argc, object str, ...) result = (int)strtol(string_str(str), NULL, 2); } else if (base_num == 8) { result = (int)strtol(string_str(str), NULL, 8); + } else if (base_num == 10) { + Cyc_string2number_(data, cont, str); // Default processing } else if (base_num == 16) { result = (int)strtol(string_str(str), NULL, 16); } @@ -1849,7 +1851,7 @@ object Cyc_string2number2_(void *data, object cont, int argc, object str, ...) if (MP_OKAY != mp_read_radix(&(bignum_value(bn)), string_str(str), base_num)) { Cyc_rt_raise2(data, "Error converting string to bignum", str); } - _return_closcall1(data, cont, bn); + _return_closcall1(data, cont, Cyc_bignum_normalize(data, bn)); } else { _return_closcall1(data, cont, obj_int2obj(result)); }