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

Issue #320 - Ensure caller has ref to child thread

Browse source
This commit is contained in:
Justin Ethier 2019-06-07 16:12:31 -04:00
parent 9122afdc83
commit 22ca4ff85a
2 changed files with 44 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
runtime.c
View file

@ -1943,6 +1943,23 @@ object Cyc_vector_ref(void *data, object v, object k)
return ((vector) v)->elements[idx];
}
object _unsafe_Cyc_vector_ref(object v, object k)
{
int idx;
if (Cyc_is_vector(v) == boolean_f ||
Cyc_is_fixnum(k) == boolean_f)
{
return NULL;
}
idx = unbox_number(k);
if (idx < 0 || idx >= ((vector) v)->num_elements) {
return NULL;
}
return ((vector) v)->elements[idx];
}
object Cyc_vector_length(void *data, object v)
{
if ((v != NULL) && !is_value_type(v) && ((list) v)->tag == vector_tag) {
@ -6185,10 +6202,21 @@ void *Cyc_init_thread(object thread_and_thunk)
{
vector_type *t;
c_opaque_type *o;
object op, parent, child;
object op, parent, child, tmp;
long stack_start;
gc_thread_data *thd;
thd = malloc(sizeof(gc_thread_data));
// Extract passed-in thread data object
tmp = car(thread_and_thunk);
t = (vector_type *)tmp;
op = _unsafe_Cyc_vector_ref(t, obj_int2obj(2)); // Field set in thread-start!
if (op == NULL) {
// Should never happen
thd = malloc(sizeof(gc_thread_data));
} else {
o = (c_opaque_type *)op;
thd = (gc_thread_data *)(opaque_ptr(o));
}
gc_thread_data_init(thd, 0, (char *)&stack_start, global_stack_size);
thd->scm_thread_obj = car(thread_and_thunk);
thd->gc_cont = cdr(thread_and_thunk);
@ -6198,7 +6226,7 @@ void *Cyc_init_thread(object thread_and_thunk)
// 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!
op = Cyc_vector_ref(thd, t, obj_int2obj(5)); // 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;

18
srfi/18.sld
View file

@ -70,7 +70,8 @@
;; - internal thread id (implementation-specific)
;; - name
;; - specific
(vector 'cyc-thread-obj thunk #f name-str #f)))
;; - internal
(vector 'cyc-thread-obj thunk #f name-str #f #f)))
(define (thread-name t) (vector-ref t 3))
(define (thread-specific t) (vector-ref t 4))
@ -83,7 +84,7 @@
t)))
(define *primordial-thread*
(vector 'cyc-thread-obj #f #f "main thread" #f))
(vector 'cyc-thread-obj #f #f "main thread" #f #f))
(define-c %current-thread
"(void *data, int argc, closure _, object k)"
@ -96,15 +97,22 @@
make_c_opaque(co, td);
return_closcall1(data, k, &co); ")
(define-c %alloc-thread-data
"(void *data, int argc, closure _, object k)"
" gc_thread_data *td = malloc(sizeof(gc_thread_data));
make_c_opaque(co, td);
return_closcall1(data, k, &co); ")
(define (thread-start! t)
;; Initiate a GC prior to running the thread, in case
;; t contains any closures on the "parent" thread's stack
;; it contains any closures on the "parent" thread's stack
(let* ((thunk (vector-ref t 1))
(thread-params (cons t (lambda ()
(vector-set! t 2 (%get-thread-data))
(vector-set! t 5 #f)
(thunk)))))
(vector-set! t 2 (%get-thread-data)) ;; Temporarily make parent thread
(vector-set! t 5 (%get-thread-data)) ;; Temporarily make parent thread
;; data available for child init
(vector-set! t 2 (%alloc-thread-data)) ;; Data for new thread
(Cyc-minor-gc)
(Cyc-spawn-thread! thread-params)
))