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

Merge branch 'thread-params-dev'

Browse source
This commit is contained in:
Justin Ethier 2017-03-16 20:50:23 +00:00
commit 4834981ba2
8 changed files with 143 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
atomics.sld Normal file
View file

@ -0,0 +1,15 @@
(define-library (atomics)
(export
atomic:get
atomic:set!
)
(include-c-header "<ck_pr.h>")
(begin
;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); ")
))

12
examples/threading/parameters.scm
View file

@ -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! 1200)
(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))

16
gc.c
View file

@ -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]);
@ -1690,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]);
@ -1883,6 +1898,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;

2
include/cyclone/runtime.h
View file

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

2
include/cyclone/types.h
View file

@ -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 */

52
runtime.c
View file

@ -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) ||
@ -1833,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);
}
@ -1842,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));
}
@ -4776,6 +4785,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
@ -5318,11 +5328,29 @@ 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
*/
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));
@ -5332,6 +5360,28 @@ 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();
// 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 (parent) {
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(parent)), cdr(car(parent)));
parent = cdr(parent);
}
// Done initializing parameter objects
gc_add_mutator(thd);
ck_pr_cas_int((int *)&(thd->thread_state), CYC_THREAD_STATE_NEW,
CYC_THREAD_STATE_RUNNABLE);

50
scheme/base.sld
View file

@ -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,21 +949,62 @@
()
((param value) ...)
body))))
(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)"
" 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
(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))
;;
(set-param-obj! (cons key value))
(lambda args
(cond
((null? args)
value)
;; 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)
((eq? (car args) '<param-set!>)
(set! value (cadr args)))
(let ((cell (assoc key (get-param-objs))))
(set-cdr! cell (cadr args))))
;(set! value (cadr args)))
((eq? (car args) '<param-convert>)
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)))

2
srfi/18.sld
View file

@ -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)
))