suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added (current-future) as a non-blocking primitive to racket/future.

Browse Source
This commit is contained in:
James Swaine 2010-08-18 22:15:19 -05:00
parent fd109558de
commit 8675db4faa
4 changed files with 47 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/racket/future.rkt
View File

@ -4,4 +4,5 @@
(provide future?
future
touch
processor-count)
processor-count
current-future)

35
src/racket/src/future.c
View File

@ -60,6 +60,11 @@ static Scheme_Object *future(int argc, Scheme_Object *argv[])
return (Scheme_Object *)ft;
}
static Scheme_Object *current_future(int argc, Scheme_Object *argv[])
{
return scheme_make_null();
}
static Scheme_Object *touch(int argc, Scheme_Object *argv[])
{
future_t * volatile ft;
@ -137,6 +142,7 @@ void scheme_init_futures(Scheme_Env *env)
FUTURE_PRIM_W_ARITY("future", future, 1, 1, newenv);
FUTURE_PRIM_W_ARITY("touch", touch, 1, 1, newenv);
FUTURE_PRIM_W_ARITY("processor-count", processor_count, 0, 0, newenv);
FUTURE_PRIM_W_ARITY("current-future", current_future, 0, 0, newenv);
scheme_finish_primitive_module(newenv);
scheme_protect_primitive_provide(newenv, NULL);
@ -296,7 +302,7 @@ typedef struct future_thread_params_t {
/* Invoked by the runtime on startup to make primitives known */
void scheme_init_futures(Scheme_Env *env)
{
Scheme_Object *v;
Scheme_Object *v, *p;
Scheme_Env *newenv;
futures_init();
@ -340,6 +346,24 @@ void scheme_init_futures(Scheme_Env *env)
1,
1),
newenv);
/*
scheme_add_global_constant(
"current-future",
scheme_make_prim_w_arity(
current_future,
"current-future",
0,
0),
newenv);
*/
p = scheme_make_immed_prim(
current_future,
"current-future",
0,
0);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("current-future", p, newenv);
scheme_finish_primitive_module(newenv);
scheme_protect_primitive_provide(newenv, NULL);
@ -625,6 +649,15 @@ Scheme_Object *future(int argc, Scheme_Object *argv[])
return (Scheme_Object*)ft;
}
Scheme_Object *current_future(int argc, Scheme_Object *argv[])
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
if (NULL == fts || NULL == fts->current_ft)
return scheme_make_null();
return (Scheme_Object*)(fts->current_ft);
}
int future_ready(Scheme_Object *obj)
/* Called in runtime thread by Scheme scheduler */

2
src/racket/src/future.h
View File

@ -141,6 +141,8 @@ void scheme_future_continue_after_gc();
void scheme_check_future_work();
void scheme_future_gc_pause();
Scheme_Object *current_future(int argc, Scheme_Object *argv[]);
#ifdef UNIT_TEST
//These forwarding decls only need to be here to make
//primitives visible to test cases written in C

10
src/racket/src/jit.c
View File

@ -8231,7 +8231,7 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
/* de-sync's; for branch, sync'd before */
{
Scheme_Object *rator = app->args[0];
if (!SCHEME_PRIMP(rator))
return 0;
@ -8260,6 +8260,14 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
} else if (IS_NAMED_PRIM(rator, ">=")) {
generate_nary_arith(jitter, app, 0, 1, for_branch, branch_short);
return 1;
} else if (IS_NAMED_PRIM(rator, "current-future")) {
printf("current-future\n");
mz_rs_sync();
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
mz_prepare(0);
mz_finish(current_future);
jit_retval(JIT_R0);
return 1;
} else if (!for_branch) {
if (IS_NAMED_PRIM(rator, "vector-set!")
|| IS_NAMED_PRIM(rator, "unsafe-vector-set!")