490 |
} |
} |
491 |
#undef FUNC_NAME |
#undef FUNC_NAME |
492 |
|
|
493 |
|
SCM *scm_loc_sys_thread_handler; |
494 |
|
|
495 |
|
SCM |
496 |
|
scm_i_make_future (SCM thunk) |
497 |
|
{ |
498 |
|
SCM_RETURN_NEWSMOB2 (scm_tc16_future, |
499 |
|
create_thread ((scm_t_catch_body) scm_call_0, |
500 |
|
thunk, |
501 |
|
(scm_t_catch_handler) scm_apply_1, |
502 |
|
*scm_loc_sys_thread_handler, |
503 |
|
scm_cons (thunk, |
504 |
|
*scm_loc_sys_thread_handler)), |
505 |
|
scm_make_rec_mutex ()); |
506 |
|
} |
507 |
|
|
508 |
|
static size_t |
509 |
|
future_free (SCM future) |
510 |
|
{ |
511 |
|
scm_rec_mutex_free (SCM_FUTURE_MUTEX (future)); |
512 |
|
return 0; |
513 |
|
} |
514 |
|
|
515 |
|
static int |
516 |
|
future_print (SCM exp, SCM port, scm_print_state *pstate) |
517 |
|
{ |
518 |
|
int writingp = SCM_WRITINGP (pstate); |
519 |
|
scm_puts ("#<future ", port); |
520 |
|
SCM_SET_WRITINGP (pstate, 1); |
521 |
|
scm_iprin1 (SCM_FUTURE_DATA (exp), port, pstate); |
522 |
|
SCM_SET_WRITINGP (pstate, writingp); |
523 |
|
scm_putc ('>', port); |
524 |
|
return !0; |
525 |
|
} |
526 |
|
|
527 |
|
SCM_DEFINE (scm_future_ref, "future-ref", 1, 0, 0, |
528 |
|
(SCM future), |
529 |
|
"If the future @var{x} has not been computed yet, compute and\n" |
530 |
|
"return @var{x}, otherwise just return the previously computed\n" |
531 |
|
"value.") |
532 |
|
#define FUNC_NAME s_scm_future_ref |
533 |
|
{ |
534 |
|
SCM_VALIDATE_FUTURE (1, future); |
535 |
|
scm_rec_mutex_lock (SCM_FUTURE_MUTEX (future)); |
536 |
|
if (!SCM_FUTURE_COMPUTED_P (future)) |
537 |
|
{ |
538 |
|
SCM value = scm_join_thread (SCM_FUTURE_DATA (future)); |
539 |
|
if (!SCM_FUTURE_COMPUTED_P (future)) |
540 |
|
{ |
541 |
|
SCM_SET_FUTURE_DATA (future, value); |
542 |
|
SCM_SET_FUTURE_COMPUTED (future); |
543 |
|
} |
544 |
|
} |
545 |
|
scm_rec_mutex_unlock (SCM_FUTURE_MUTEX (future)); |
546 |
|
return SCM_FUTURE_DATA (future); |
547 |
|
} |
548 |
|
#undef FUNC_NAME |
549 |
|
|
550 |
/*** Fair mutexes */ |
/*** Fair mutexes */ |
551 |
|
|
552 |
/* We implement our own mutex type since we want them to be 'fair', we |
/* We implement our own mutex type since we want them to be 'fair', we |
1125 |
return res; |
return res; |
1126 |
} |
} |
1127 |
|
|
1128 |
|
scm_t_rec_mutex * |
1129 |
|
scm_make_rec_mutex () |
1130 |
|
{ |
1131 |
|
scm_t_rec_mutex *m = scm_malloc (sizeof (scm_t_rec_mutex)); |
1132 |
|
scm_i_plugin_rec_mutex_init (m, &scm_i_plugin_rec_mutex); |
1133 |
|
return m; |
1134 |
|
} |
1135 |
|
|
1136 |
|
void |
1137 |
|
scm_rec_mutex_free (scm_t_rec_mutex *m) |
1138 |
|
{ |
1139 |
|
scm_i_plugin_rec_mutex_destroy (m); |
1140 |
|
free (m); |
1141 |
|
} |
1142 |
|
|
1143 |
|
int |
1144 |
|
scm_rec_mutex_lock (scm_t_rec_mutex *m) |
1145 |
|
{ |
1146 |
|
scm_thread *t = scm_i_leave_guile (); |
1147 |
|
int res = scm_i_plugin_rec_mutex_lock (m); |
1148 |
|
scm_i_enter_guile (t); |
1149 |
|
return res; |
1150 |
|
} |
1151 |
|
|
1152 |
int |
int |
1153 |
scm_cond_wait (scm_t_cond *c, scm_t_mutex *m) |
scm_cond_wait (scm_t_cond *c, scm_t_mutex *m) |
1154 |
{ |
{ |
1247 |
|
|
1248 |
static scm_t_cond wake_up_cond; |
static scm_t_cond wake_up_cond; |
1249 |
int scm_i_thread_go_to_sleep; |
int scm_i_thread_go_to_sleep; |
1250 |
static scm_t_mutex gc_section_mutex; |
static scm_t_rec_mutex gc_section_mutex; |
|
static scm_thread *gc_section_owner; |
|
1251 |
static int gc_section_count = 0; |
static int gc_section_count = 0; |
1252 |
static int threads_initialized_p = 0; |
static int threads_initialized_p = 0; |
1253 |
|
|
1254 |
void |
void |
1255 |
scm_i_thread_put_to_sleep () |
scm_i_thread_put_to_sleep () |
1256 |
{ |
{ |
1257 |
SCM_REC_CRITICAL_SECTION_START (gc_section); |
scm_rec_mutex_lock (&gc_section_mutex); |
1258 |
if (threads_initialized_p && gc_section_count == 1) |
if (threads_initialized_p && !gc_section_count++) |
1259 |
{ |
{ |
1260 |
SCM threads; |
SCM threads; |
1261 |
scm_i_plugin_mutex_lock (&thread_admin_mutex); |
scm_i_plugin_mutex_lock (&thread_admin_mutex); |
1289 |
void |
void |
1290 |
scm_i_thread_wake_up () |
scm_i_thread_wake_up () |
1291 |
{ |
{ |
1292 |
if (threads_initialized_p && gc_section_count == 1) |
if (threads_initialized_p && !--gc_section_count) |
1293 |
{ |
{ |
1294 |
SCM threads; |
SCM threads; |
1295 |
/* Need to lock since woken threads can die and be deleted from list */ |
/* Need to lock since woken threads can die and be deleted from list */ |
1304 |
} |
} |
1305 |
scm_i_plugin_mutex_unlock (&thread_admin_mutex); |
scm_i_plugin_mutex_unlock (&thread_admin_mutex); |
1306 |
} |
} |
1307 |
SCM_REC_CRITICAL_SECTION_END (gc_section); |
scm_rec_mutex_unlock (&gc_section_mutex); |
1308 |
} |
} |
1309 |
|
|
1310 |
void |
void |
1316 |
resume (t); |
resume (t); |
1317 |
} |
} |
1318 |
|
|
|
/* The mother of all recursive critical sections */ |
|
|
scm_t_mutex scm_i_section_mutex; |
|
|
|
|
1319 |
scm_t_mutex scm_i_critical_section_mutex; |
scm_t_mutex scm_i_critical_section_mutex; |
1320 |
scm_t_mutex scm_i_defer_mutex; |
scm_t_rec_mutex scm_i_defer_mutex; |
1321 |
int scm_i_defer_count = 0; |
|
1322 |
scm_thread *scm_i_defer_owner = 0; |
#ifdef USE_PTHREAD_THREADS |
1323 |
|
#include "libguile/pthread-threads.c" |
1324 |
|
#endif |
1325 |
|
|
1326 |
/*** Initialization */ |
/*** Initialization */ |
1327 |
|
|
1329 |
scm_threads_prehistory () |
scm_threads_prehistory () |
1330 |
{ |
{ |
1331 |
scm_thread *t; |
scm_thread *t; |
1332 |
scm_i_plugin_mutex_init (&thread_admin_mutex, 0); |
scm_i_plugin_mutex_init (&thread_admin_mutex, &scm_i_plugin_mutex); |
1333 |
scm_i_plugin_mutex_init (&gc_section_mutex, 0); |
scm_i_plugin_rec_mutex_init (&gc_section_mutex, &scm_i_plugin_rec_mutex); |
1334 |
scm_i_plugin_cond_init (&wake_up_cond, 0); |
scm_i_plugin_cond_init (&wake_up_cond, 0); |
1335 |
scm_i_plugin_mutex_init (&scm_i_critical_section_mutex, 0); |
scm_i_plugin_mutex_init (&scm_i_critical_section_mutex, &scm_i_plugin_mutex); |
1336 |
thread_count = 1; |
thread_count = 1; |
1337 |
scm_i_plugin_key_create (&scm_i_thread_key, 0); |
scm_i_plugin_key_create (&scm_i_thread_key, 0); |
1338 |
scm_i_plugin_key_create (&scm_i_root_state_key, 0); |
scm_i_plugin_key_create (&scm_i_root_state_key, 0); |
1339 |
scm_i_plugin_mutex_init (&scm_i_defer_mutex, 0); |
scm_i_plugin_rec_mutex_init (&scm_i_defer_mutex, &scm_i_plugin_rec_mutex); |
|
scm_i_plugin_mutex_init (&scm_i_section_mutex, 0); |
|
1340 |
/* Allocate a fake thread object to be used during bootup. */ |
/* Allocate a fake thread object to be used during bootup. */ |
1341 |
t = malloc (sizeof (scm_thread)); |
t = malloc (sizeof (scm_thread)); |
1342 |
t->base = NULL; |
t->base = NULL; |
1343 |
t->clear_freelists_p = 0; |
t->clear_freelists_p = 0; |
1344 |
scm_setspecific (scm_i_thread_key, t); |
scm_setspecific (scm_i_thread_key, t); |
1345 |
|
#ifdef USE_PTHREAD_THREADS |
1346 |
|
scm_init_pthread_threads (); |
1347 |
|
#endif |
1348 |
} |
} |
1349 |
|
|
1350 |
scm_t_bits scm_tc16_thread; |
scm_t_bits scm_tc16_thread; |
1351 |
|
scm_t_bits scm_tc16_future; |
1352 |
scm_t_bits scm_tc16_mutex; |
scm_t_bits scm_tc16_mutex; |
1353 |
scm_t_bits scm_tc16_fair_mutex; |
scm_t_bits scm_tc16_fair_mutex; |
1354 |
scm_t_bits scm_tc16_condvar; |
scm_t_bits scm_tc16_condvar; |
1387 |
|
|
1388 |
scm_set_smob_mark (scm_tc16_fair_condvar, fair_cond_mark); |
scm_set_smob_mark (scm_tc16_fair_condvar, fair_cond_mark); |
1389 |
|
|
1390 |
|
scm_tc16_future = scm_make_smob_type ("future", 0); |
1391 |
|
scm_set_smob_mark (scm_tc16_future, scm_markcdr); |
1392 |
|
scm_set_smob_free (scm_tc16_future, future_free); |
1393 |
|
scm_set_smob_print (scm_tc16_future, future_print); |
1394 |
|
|
1395 |
threads_initialized_p = 1; |
threads_initialized_p = 1; |
1396 |
} |
} |
1397 |
|
|
1398 |
void |
void |
1399 |
scm_init_thread_procs () |
scm_init_thread_procs () |
1400 |
{ |
{ |
1401 |
|
scm_loc_sys_thread_handler |
1402 |
|
= SCM_VARIABLE_LOC (scm_c_define ("%thread-handler", SCM_BOOL_F)); |
1403 |
#include "libguile/threads.x" |
#include "libguile/threads.x" |
1404 |
} |
} |
1405 |
|
|