Scheme_Object* scheme_initialize( Scheme_Env * env )
{
DWORD threadID;
Scheme_Env * menv;
Scheme_Small_Object * hotkey_event;
g_native_semaphore = CreateSemaphore( NULL, 0, 500, SEMA_NAME );
CreateThread( NULL, 0, ThreadProc, NULL, 0, &threadID );
menv = scheme_primitive_module( scheme_module_name(), env );
g_hotkey_event_type = scheme_make_type("<system-event>");
hotkey_event = (Scheme_Small_Object*) scheme_malloc( sizeof(Scheme_Small_Object) );
hotkey_event->iso.so.type = g_hotkey_event_type;
hotkey_event->u.int_val = (long)g_native_semaphore;
scheme_register_extension_global( hotkey_event, sizeof(Scheme_Small_Object) );
scheme_add_evt( g_hotkey_event_type,
(Scheme_Ready_Fun) scheme_hotkey_inactive,
(Scheme_Needs_Wakeup_Fun) scheme_hotkey_needs_wakeup,
NULL, 0);
scheme_add_global( "system-events-event", (Scheme_Object*) hotkey_event, menv );
scheme_add_global( "last-system-event",
scheme_make_prim_w_arity( scm_last_system_event, "last-system-event", 0, 0 ),
menv );
scheme_finish_primitive_module( menv );
return scheme_void;
}
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);
}
void scheme_init_places_once() {
#ifdef MZ_USE_PLACES
scheme_add_evt(scheme_place_type, (Scheme_Ready_Fun)scheme_place_channel_ready, NULL, NULL, 1);
scheme_add_evt(scheme_place_bi_channel_type, (Scheme_Ready_Fun)scheme_place_channel_ready, NULL, NULL, 1);
#endif
}
