suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix problems with place termination

Browse Source
This commit is contained in:
Matthew Flatt 2012-02-29 20:20:05 -07:00
parent ab9f63a3a0
commit facb411a63
2 changed files with 54 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
collects/tests/racket/ffi-orig-place.rkt
View File

@ -8,18 +8,30 @@
(define scheme_malloc_atomic
(get-ffi-obj 'GC_malloc_atomic #f (_fun #:in-original-place? #t _long -> _pointer)))
(define (main)
(define (x-main)
(define ps
(for/list ([j (in-range 4)])
(place pch
;; Start a thread that keep having to wait on the original place:
(thread
(lambda ()
(let loop ()
(scheme_malloc_atomic 10)
(loop))))
;; Create a lot of message channels to trigger master GC:
(for ([i (in-range 100000)])
(place-channel))
(printf "done\n"))))
(define p
(place pch
(define j (place-channel-get pch))
;; Start a thread that keep having to wait on the original place:
(thread
(lambda ()
(let loop ()
(scheme_malloc_atomic 10)
(loop))))
;; Create a lot of message channels to trigger master GC:
(for ([i (in-range 10000)])
(place-channel))
(printf "done\n")
;; Helps check exit handling:
(when (even? j) (exit 1))))
(place-channel-put p j)
p))
(for-each place-wait ps))
(define (main)
(for ([i 5])
(printf "iter ~a\n" i)
(x-main)))

52
src/racket/src/place.c
View File

@ -2348,14 +2348,41 @@ static void place_set_result(Scheme_Object *result)
mzrt_mutex_unlock(place_object->lock);
}
static void terminate_current_place()
{
intptr_t place_obj_die;
intptr_t refcount;
Scheme_Place_Object *place_obj;
place_obj = place_object;
mzrt_mutex_lock(place_obj->lock);
place_obj_die = place_obj->die;
place_obj->refcount--;
refcount = place_obj->refcount;
mzrt_mutex_unlock(place_obj->lock);
if (!refcount)
destroy_place_object_locks(place_obj);
place_object = NULL;
/*printf("Leavin place: proc thread id%u\n", ptid);*/
/* Beware that the destroy operation might trigger a GC to cooperate
with the master GC: */
scheme_place_instance_destroy(place_obj_die);
}
static Scheme_Object *def_place_exit_handler_proc(int argc, Scheme_Object *argv[])
{
scheme_log(NULL, SCHEME_LOG_DEBUG, 0, "place %d: exiting via (exit)", scheme_current_place_id);
place_set_result(argv[0]);
/*printf("Leavin place: proc thread id%u\n", ptid);*/
scheme_place_instance_destroy(0);
terminate_current_place();
mz_proc_thread_exit(NULL);
@ -2504,26 +2531,7 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
scheme_log(NULL, SCHEME_LOG_DEBUG, 0, "place %d: exiting", scheme_current_place_id);
{
intptr_t place_obj_die;
intptr_t refcount;
mzrt_mutex_lock(place_obj->lock);
place_obj_die = place_obj->die;
place_obj->refcount--;
refcount = place_obj->refcount;
mzrt_mutex_unlock(place_obj->lock);
if(!refcount) {
destroy_place_object_locks(place_obj);
place_object = NULL;
}
/*printf("Leavin place: proc thread id%u\n", ptid);*/
scheme_place_instance_destroy(place_obj_die);
}
terminate_current_place();
return NULL;
}