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