Scheme_Object *scheme_make_sema_repost(Scheme_Object *sema)
{
Scheme_Object *o;
o = scheme_alloc_small_object();
o->type = scheme_semaphore_repost_type;
SCHEME_PTR_VAL(o) = sema;
return o;
}
Scheme_Object *scheme_box(Scheme_Object *v)
{
Scheme_Object *obj;
obj = scheme_alloc_small_object();
obj->type = scheme_box_type;
SCHEME_BOX_VAL(obj) = v;
return obj;
}
void scheme_init_sema(Scheme_Env *env)
{
Scheme_Object *o;
#ifdef MZ_PRECISE_GC
register_traversers();
#endif
scheme_add_global_constant("make-semaphore",
scheme_make_prim_w_arity(make_sema,
"make-semaphore",
0, 1),
env);
scheme_add_global_constant("semaphore?",
scheme_make_folding_prim(semap,
"semaphore?",
1, 1, 1),
env);
scheme_add_global_constant("semaphore-post",
scheme_make_prim_w_arity(hit_sema,
"semaphore-post",
1, 1),
env);
scheme_add_global_constant("semaphore-try-wait?",
scheme_make_prim_w_arity(block_sema_p,
"semaphore-try-wait?",
1, 1),
env);
scheme_add_global_constant("semaphore-wait",
scheme_make_prim_w_arity(block_sema,
"semaphore-wait",
1, 1),
env);
scheme_add_global_constant("semaphore-wait/enable-break",
scheme_make_prim_w_arity(block_sema_breakable,
"semaphore-wait/enable-break",
1, 1),
env);
scheme_add_global_constant("semaphore-peek-evt",
scheme_make_prim_w_arity(make_sema_repost,
"semaphore-peek-evt",
1, 1),
env);
scheme_add_global_constant("make-channel",
scheme_make_prim_w_arity(make_channel,
"make-channel",
0, 0),
env);
scheme_add_global_constant("channel-put-evt",
scheme_make_prim_w_arity(make_channel_put,
"channel-put-evt",
2, 2),
env);
scheme_add_global_constant("channel?",
scheme_make_folding_prim(channel_p,
"channel?",
1, 1, 1),
env);
scheme_add_global_constant("thread-send",
scheme_make_prim_w_arity(thread_send,
"thread-send",
2, 3),
env);
scheme_add_global_constant("thread-receive",
scheme_make_prim_w_arity(thread_receive,
"thread-receive",
0, 0),
env);
scheme_add_global_constant("thread-try-receive",
scheme_make_prim_w_arity(thread_try_receive,
"thread-try-receive",
0, 0),
env);
scheme_add_global_constant("thread-receive-evt",
scheme_make_prim_w_arity(thread_receive_evt,
"thread-receive-evt",
0, 0),
env);
scheme_add_global_constant("thread-rewind-receive",
scheme_make_prim_w_arity(thread_rewind_receive,
"thread-rewind-receive",
1, 1),
env);
scheme_add_global_constant("alarm-evt",
scheme_make_prim_w_arity(make_alarm,
"alarm-evt",
1, 1),
env);
scheme_add_global_constant("system-idle-evt",
scheme_make_prim_w_arity(make_sys_idle,
"system-idle-evt",
0, 0),
env);
REGISTER_SO(scheme_always_ready_evt);
scheme_always_ready_evt = scheme_alloc_small_object();
scheme_always_ready_evt->type = scheme_always_evt_type;
scheme_add_global_constant("always-evt", scheme_always_ready_evt, env);
o = scheme_alloc_small_object();
o->type = scheme_never_evt_type;
scheme_add_global_constant("never-evt", o, env);
REGISTER_SO(thread_recv_evt);
o = scheme_alloc_small_object();
o->type = scheme_thread_recv_evt_type;
thread_recv_evt = o;
scheme_add_evt(scheme_sema_type, sema_ready, NULL, NULL, 0);
scheme_add_evt_through_sema(scheme_semaphore_repost_type, sema_for_repost, NULL);
scheme_add_evt(scheme_channel_type, (Scheme_Ready_Fun)channel_get_ready, NULL, NULL, 1);
scheme_add_evt(scheme_channel_put_type, (Scheme_Ready_Fun)channel_put_ready, NULL, NULL, 1);
scheme_add_evt(scheme_channel_syncer_type, (Scheme_Ready_Fun)channel_syncer_ready, NULL, NULL, 0);
scheme_add_evt(scheme_alarm_type, (Scheme_Ready_Fun)alarm_ready, NULL, NULL, 0);
scheme_add_evt(scheme_always_evt_type, always_ready, NULL, NULL, 0);
scheme_add_evt(scheme_never_evt_type, never_ready, NULL, NULL, 0);
scheme_add_evt(scheme_thread_recv_evt_type, (Scheme_Ready_Fun)thread_recv_ready, NULL, NULL, 0);
}
