Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-07 05:06:37 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Need to unpause a paused thread if we want to terminate it.

Browse source
This commit is contained in:
Alex Shinn 2012-07-21 17:05:05 +09:00
parent 680e2fe169
commit cdb8760fcc
1 changed files with 31 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
lib/srfi/18/threads.c
View file

@ -1,5 +1,5 @@
/* threads.c -- SRFI-18 thread primitives */ /* threads.c -- SRFI-18 thread primitives */
/* Copyright (c) 2010-2011 Alex Shinn. All rights reserved. */ /* Copyright (c) 2010-2012 Alex Shinn. All rights reserved. */
/* BSD-style license: http://synthcode.com/license.txt */ /* BSD-style license: http://synthcode.com/license.txt */
#include <chibi/eval.h> #include <chibi/eval.h>
@ -96,20 +96,12 @@ sexp sexp_thread_start (sexp ctx, sexp self, sexp_sint_t n, sexp thread) {
if (sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) { if (sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = cell; sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = cell;
sexp_global(ctx, SEXP_G_THREADS_BACK) = cell; sexp_global(ctx, SEXP_G_THREADS_BACK) = cell;
} else { /* init queue */ } else { /* init queue */
sexp_global(ctx, SEXP_G_THREADS_BACK) = sexp_global(ctx, SEXP_G_THREADS_FRONT) = cell; sexp_global(ctx, SEXP_G_THREADS_BACK) = sexp_global(ctx, SEXP_G_THREADS_FRONT) = cell;
} }
return thread; return thread;
} }
sexp sexp_thread_terminate (sexp ctx, sexp self, sexp_sint_t n, sexp thread) {
sexp res = sexp_make_boolean(ctx == thread);
for ( ; thread && sexp_contextp(thread); thread=sexp_context_child(thread))
sexp_context_refuel(thread) = 0;
/* return true if terminating self */
return res;
}
static int sexp_delete_list (sexp ctx, int global, sexp x) { static int sexp_delete_list (sexp ctx, int global, sexp x) {
sexp ls1=NULL, ls2=sexp_global(ctx, global); sexp ls1=NULL, ls2=sexp_global(ctx, global);
for ( ; sexp_pairp(ls2) && sexp_car(ls2) != x; ls1=ls2, ls2=sexp_cdr(ls2)) for ( ; sexp_pairp(ls2) && sexp_car(ls2) != x; ls1=ls2, ls2=sexp_cdr(ls2))
@ -123,6 +115,20 @@ static int sexp_delete_list (sexp ctx, int global, sexp x) {
} }
} }
sexp sexp_thread_terminate (sexp ctx, sexp self, sexp_sint_t n, sexp thread) {
sexp res = sexp_make_boolean(ctx == thread);
/* terminate the thread and all children */
for ( ; thread && sexp_contextp(thread); thread=sexp_context_child(thread)) {
/* zero the refuel - this tells the scheduler the thread is terminated */
sexp_context_refuel(thread) = 0;
/* unblock the thread if needed so it can be scheduled and terminated */
if (sexp_delete_list(ctx, SEXP_G_THREADS_PAUSED, thread))
sexp_thread_start(ctx, self, 1, thread);
}
/* return true if terminating self, then we can yield */
return res;
}
static void sexp_insert_timed (sexp ctx, sexp thread, sexp timeout) { static void sexp_insert_timed (sexp ctx, sexp thread, sexp timeout) {
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
double d; double d;
@ -256,13 +262,13 @@ sexp sexp_condition_variable_signal (sexp ctx, sexp self, sexp_sint_t n, sexp co
for ( ; sexp_pairp(ls2); ls1=ls2, ls2=sexp_cdr(ls2)) for ( ; sexp_pairp(ls2); ls1=ls2, ls2=sexp_cdr(ls2))
if (sexp_context_event(sexp_car(ls2)) == condvar) { if (sexp_context_event(sexp_car(ls2)) == condvar) {
if (ls1==SEXP_NULL) if (ls1==SEXP_NULL)
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(ls2); sexp_global(ctx, SEXP_G_THREADS_PAUSED) = sexp_cdr(ls2);
else else
sexp_cdr(ls1) = sexp_cdr(ls2); sexp_cdr(ls1) = sexp_cdr(ls2);
sexp_cdr(ls2) = sexp_global(ctx, SEXP_G_THREADS_FRONT); sexp_cdr(ls2) = sexp_global(ctx, SEXP_G_THREADS_FRONT);
sexp_global(ctx, SEXP_G_THREADS_FRONT) = ls2; sexp_global(ctx, SEXP_G_THREADS_FRONT) = ls2;
if (! sexp_pairp(sexp_cdr(ls2))) if (! sexp_pairp(sexp_cdr(ls2)))
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2; sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
sexp_context_waitp(sexp_car(ls2)) = sexp_context_timeoutp(sexp_car(ls2)) = 0; sexp_context_waitp(sexp_car(ls2)) = sexp_context_timeoutp(sexp_car(ls2)) = 0;
return SEXP_TRUE; return SEXP_TRUE;
} }
@ -459,12 +465,12 @@ sexp sexp_scheduler (sexp ctx, sexp self, sexp_sint_t n, sexp root_thread) {
sexp_cdr(ls1) = sexp_cdr(ls2); sexp_cdr(ls1) = sexp_cdr(ls2);
tmp = sexp_cdr(ls2); tmp = sexp_cdr(ls2);
sexp_cdr(ls2) = SEXP_NULL; sexp_cdr(ls2) = SEXP_NULL;
if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) { if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = ls2; sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = ls2;
} else { } else {
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = ls2; sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = ls2;
} }
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2; sexp_global(ctx, SEXP_G_THREADS_BACK) = ls2;
ls2 = tmp; ls2 = tmp;
} else { } else {
ls1 = ls2; ls1 = ls2;
@ -486,12 +492,12 @@ sexp sexp_scheduler (sexp ctx, sexp self, sexp_sint_t n, sexp root_thread) {
} }
if (sexp_pairp(ls1)) { if (sexp_pairp(ls1)) {
sexp_cdr(ls1) = SEXP_NULL; sexp_cdr(ls1) = SEXP_NULL;
if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) { if (! sexp_pairp(sexp_global(ctx, SEXP_G_THREADS_BACK))) {
sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = paused; sexp_global(ctx, SEXP_G_THREADS_FRONT) = front = paused;
} else { } else {
sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = paused; sexp_cdr(sexp_global(ctx, SEXP_G_THREADS_BACK)) = paused;
} }
sexp_global(ctx, SEXP_G_THREADS_BACK) = ls1; sexp_global(ctx, SEXP_G_THREADS_BACK) = ls1;
sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = ls2; sexp_global(ctx, SEXP_G_THREADS_PAUSED) = paused = ls2;
} }
} }