From dcf299173667cfc249a30559f92cce4c1a023c10 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 23 Nov 2009 23:00:08 +0000 Subject: [PATCH] future fixes: continuation barrier in place, handle multiple results from a future svn: r17019 --- src/mzscheme/src/future.c | 106 +++++++++++++++++++++---- src/mzscheme/src/future.h | 2 + src/mzscheme/src/gen-jit-ts.ss | 4 +- src/mzscheme/src/jit.c | 49 ++++++------ src/mzscheme/src/jit_ts.c | 1 - src/mzscheme/src/jit_ts_future_glue.c | 44 +++++++--- src/mzscheme/src/jit_ts_runtime_glue.c | 20 +++++ src/mzscheme/src/mzmark.c | 2 + src/mzscheme/src/mzmarksrc.c | 1 + 9 files changed, 176 insertions(+), 53 deletions(-) diff --git a/src/mzscheme/src/future.c b/src/mzscheme/src/future.c index 175ce81b66..4cd5930ec5 100644 --- a/src/mzscheme/src/future.c +++ b/src/mzscheme/src/future.c @@ -1,7 +1,24 @@ +/* + MzScheme + Copyright (c) 2006-2009 PLT Scheme Inc. -#ifndef UNIT_TEST -# include "schpriv.h" -#endif + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301 USA. +*/ + +#include "schpriv.h" //This will be TRUE if primitive tracking has been enabled //by the program @@ -27,6 +44,8 @@ typedef struct future_t { Scheme_Object *running_sema; Scheme_Object *orig_lambda; Scheme_Object *retval; + int multiple_count; + Scheme_Object **multiple_array; int no_retval; } future_t; @@ -54,7 +73,14 @@ static Scheme_Object *touch(int argc, Scheme_Object *argv[]) ft = (future_t *)argv[0]; while (1) { - if (ft->retval) return ft->retval; + if (ft->retval) { + if (SAME_OBJ(ft->retval, SCHEME_MULTIPLE_VALUES)) { + Scheme_Thread *p = scheme_current_thread; + p->ku.multiple.array = ft->multiple_array; + p->ku.multiple.count = ft->multiple_count; + } + return ft->retval; + } if (ft->no_retval) scheme_signal_error("touch: future previously aborted"); @@ -80,8 +106,13 @@ static Scheme_Object *touch(int argc, Scheme_Object *argv[]) GC_CAN_IGNORE Scheme_Object *retval, *proc; proc = ft->orig_lambda; ft->orig_lambda = NULL; /* don't hold on to proc */ - retval = _scheme_apply(proc, 0, NULL); + retval = scheme_apply_multi(proc, 0, NULL); ft->retval = retval; + if (SAME_OBJ(retval, SCHEME_MULTIPLE_VALUES)) { + ft->multiple_array = p->ku.multiple.array; + ft->multiple_count = p->ku.multiple.count; + p->ku.multiple.array = NULL; + } scheme_post_sema(ft->running_sema); p->error_buf = savebuf; } @@ -123,9 +154,6 @@ void scheme_init_futures(Scheme_Env *env) #include "future.h" #include #include -#ifdef UNIT_TEST -# include "./tests/unit_test.h" -#endif static Scheme_Object *future(int argc, Scheme_Object *argv[]); static Scheme_Object *touch(int argc, Scheme_Object *argv[]); @@ -188,6 +216,8 @@ static void *worker_thread_future_loop(void *arg); static void invoke_rtcall(Scheme_Future_State * volatile fs, future_t * volatile future); static future_t *enqueue_future(Scheme_Future_State *fs, future_t *ft);; static future_t *get_pending_future(Scheme_Future_State *fs); +static void receive_special_result(future_t *f, Scheme_Object *retval, int clear); +static void send_special_result(future_t *f, Scheme_Object *retval); #ifdef MZ_PRECISE_GC # define scheme_future_setjmp(newbuf) scheme_jit_setjmp((newbuf).jb) @@ -605,7 +635,8 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) ft->status = RUNNING; pthread_mutex_unlock(&fs->future_mutex); - retval = _scheme_apply(ft->orig_lambda, 0, NULL); + retval = scheme_apply_multi(ft->orig_lambda, 0, NULL); + send_special_result(ft, retval); pthread_mutex_lock(&fs->future_mutex); ft->work_completed = 1; @@ -614,6 +645,8 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) dequeue_future(fs, ft); pthread_mutex_unlock(&fs->future_mutex); + receive_special_result(ft, retval, 0); + return retval; } pthread_mutex_unlock(&fs->future_mutex); @@ -654,6 +687,8 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) scheme_signal_error("touch: future previously aborted"); } + receive_special_result(ft, retval, 0); + return retval; } @@ -793,18 +828,24 @@ void *worker_thread_future_loop(void *arg) v = NULL; } else { v = jitcode(ft->orig_lambda, 0, NULL); + if (SAME_OBJ(v, SCHEME_TAIL_CALL_WAITING)) { + v = scheme_ts_scheme_force_value_same_mark(v); + } } LOG("Finished running JIT code at %p.\n", ft->code); // Get future again, since a GC may have occurred ft = fts->current_ft; - + //Set the return val in the descriptor pthread_mutex_lock(&fs->future_mutex); ft->work_completed = 1; ft->retval = v; + /* In case of multiple values: */ + send_special_result(ft, v); + //Update the status ft->status = FINISHED; dequeue_future(fs, ft); @@ -960,28 +1001,35 @@ unsigned long scheme_rtcall_alloc_void_pvoid(const char *who, int src_type, prim return retval; } -static void receive_special_result(future_t *f, Scheme_Object *retval) +static void receive_special_result(future_t *f, Scheme_Object *retval, int clear) XFORM_SKIP_PROC -/* Called in future thread */ +/* Called in future or runtime thread */ { if (SAME_OBJ(retval, SCHEME_MULTIPLE_VALUES)) { Scheme_Thread *p = scheme_current_thread; p->ku.multiple.array = f->multiple_array; p->ku.multiple.count = f->multiple_count; - f->multiple_array = NULL; + if (clear) + f->multiple_array = NULL; } else if (SAME_OBJ(retval, SCHEME_TAIL_CALL_WAITING)) { Scheme_Thread *p = scheme_current_thread; p->ku.apply.tail_rator = f->tail_rator; p->ku.apply.tail_rands = f->tail_rands; p->ku.apply.tail_num_rands = f->num_tail_rands; + if (clear) { + f->tail_rator = NULL; + f->tail_rands = NULL; + } } } #include "jit_ts_future_glue.c" static void send_special_result(future_t *f, Scheme_Object *retval) + XFORM_SKIP_PROC +/* Called in future or runtime thread */ { if (SAME_OBJ(retval, SCHEME_MULTIPLE_VALUES)) { Scheme_Thread *p = scheme_current_thread; @@ -990,6 +1038,7 @@ static void send_special_result(future_t *f, Scheme_Object *retval) f->multiple_count = p->ku.multiple.count; if (SAME_OBJ(p->ku.multiple.array, p->values_buffer)) p->values_buffer = NULL; + p->ku.multiple.array = NULL; } else if (SAME_OBJ(retval, SCHEME_TAIL_CALL_WAITING)) { Scheme_Thread *p = scheme_current_thread; @@ -1019,8 +1068,11 @@ static void do_invoke_rtcall(Scheme_Future_State *fs, future_t *future) src = future->source_of_request; if (future->source_type == FSRC_RATOR) { int len; - if (SCHEME_PROCP(future->arg_s0)) - src = scheme_get_proc_name(future->arg_s0, &len, 1); + if (SCHEME_PROCP(future->arg_s0)) { + const char *src2; + src2 = scheme_get_proc_name(future->arg_s0, &len, 1); + if (src2) src = src2; + } } else if (future->source_type == FSRC_PRIM) { const char *src2; src2 = scheme_look_for_primitive(future->prim_func); @@ -1069,6 +1121,20 @@ static void do_invoke_rtcall(Scheme_Future_State *fs, future_t *future) pthread_mutex_unlock(&fs->future_mutex); } +static void *do_invoke_rtcall_k(void) +{ + Scheme_Thread *p = scheme_current_thread; + Scheme_Future_State *fs = (Scheme_Future_State *)p->ku.k.p1; + future_t *future = (future_t *)p->ku.k.p2; + + p->ku.k.p1 = NULL; + p->ku.k.p2 = NULL; + + do_invoke_rtcall(fs, future); + + return scheme_void; +} + static void invoke_rtcall(Scheme_Future_State * volatile fs, future_t * volatile future) { Scheme_Thread *p = scheme_current_thread; @@ -1087,7 +1153,15 @@ static void invoke_rtcall(Scheme_Future_State * volatile fs, future_t * volatile pthread_mutex_unlock(&fs->future_mutex); scheme_longjmp(*savebuf, 1); } else { - do_invoke_rtcall(fs, future); + if (future->rt_prim_is_atomic) { + do_invoke_rtcall(fs, future); + } else { + /* call with continuation barrier. */ + p->ku.k.p1 = fs; + p->ku.k.p2 = future; + + (void)scheme_top_level_do(do_invoke_rtcall_k, 1); + } } p->error_buf = savebuf; } diff --git a/src/mzscheme/src/future.h b/src/mzscheme/src/future.h index d6f5fc9490..a2c8eee44e 100644 --- a/src/mzscheme/src/future.h +++ b/src/mzscheme/src/future.h @@ -108,6 +108,8 @@ typedef struct future_t { # include "jit_ts_protos.h" +extern Scheme_Object *scheme_ts_scheme_force_value_same_mark(Scheme_Object *v); + //Helper macros for argument marshaling #ifdef FUTURES_ENABLED diff --git a/src/mzscheme/src/gen-jit-ts.ss b/src/mzscheme/src/gen-jit-ts.ss index e6a2f7eec9..63d896d2fe 100644 --- a/src/mzscheme/src/gen-jit-ts.ss +++ b/src/mzscheme/src/gen-jit-ts.ss @@ -81,11 +81,12 @@ [i (in-naturals)]) @string-append{ future->arg_@|(string t)|@|(number->string i)| = @|a|;}) "\n") + @(if (equal? arg-types '("Scheme_Object*")) @string-append{send_special_result(future, @(car arg-names));} "") future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; @(if (string=? result-type "void") "" @string-append{retval = @|fretval|;}) @(if (string=? result-type "void") "" @string-append{@|fretval| = 0;}) - @(if (string=? result-type "Scheme_Object*") @string-append{receive_special_result(future, retval);} "") + @(if (string=? result-type "Scheme_Object*") @string-append{receive_special_result(future, retval, 1);} "") @(if (string=? result-type "void") "" "return retval;") } }) @@ -104,6 +105,7 @@ { prim_@|ts| f = (prim_@|ts|)future->prim_func; @(if (string=? result-type "void") "" @string-append{@|result-type| retval;}) + @(if (equal? arg-types '("Scheme_Object*")) @string-append{receive_special_result(future, future->arg_s0, 1);} "") @(if (string=? result-type "void") "" "retval = ") f(@(string-join (for/list ([t (in-string (type->arg-string t))] diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 507b136694..86bbf0d048 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -392,28 +392,6 @@ static void *decrement_cache_stack_pos(void *p) THREAD_LOCAL_DECL(static Scheme_Object **fixup_runstack_base); THREAD_LOCAL_DECL(static int fixup_already_in_place); -/* FIXME?: If _scheme_tail_apply_from_native_fixup_args is called from - a future thread, then the wrong thread-local `fixup_runstack_base' - was set. But exercising this code seems to be impossible, maybe - because current bytecode optimizations never produce the case that - _scheme_tail_apply_from_native_fixup_args() was design to support. */ - -static Scheme_Object *_scheme_tail_apply_from_native_fixup_args(Scheme_Object *rator, - int argc, - Scheme_Object **argv) -{ - int already = fixup_already_in_place, i; - Scheme_Object **base; - - base = fixup_runstack_base XFORM_OK_MINUS argc XFORM_OK_MINUS already; - - /* Need to shift argc to end of base: */ - for (i = 0; i < argc; i++) { - base[already + i] = argv[i]; - } - - return _scheme_tail_apply_from_native(rator, argc + already, base); -} static Scheme_Object *make_global_ref(Scheme_Object *var) { GC_CAN_IGNORE Scheme_Object *o; @@ -2210,6 +2188,7 @@ extern int g_print_prims; mz_patch_ucbranch(refcont); \ __END_TINY_JUMPS__(1); \ } + static Scheme_Object *noncm_prim_indirect(Scheme_Prim proc, int argc) XFORM_SKIP_PROC { @@ -2222,6 +2201,7 @@ static Scheme_Object *noncm_prim_indirect(Scheme_Prim proc, int argc) else return proc(argc, MZ_RUNSTACK); } + static Scheme_Object *prim_indirect(Scheme_Primitive_Closure_Proc proc, int argc, Scheme_Object *self) XFORM_SKIP_PROC { @@ -2264,6 +2244,12 @@ static void *ts_prepare_retry_alloc(void *p, void *p2) XFORM_SKIP_PROC return ret; } #endif + +Scheme_Object *scheme_ts_scheme_force_value_same_mark(Scheme_Object *v) +{ + return ts_scheme_force_value_same_mark(v); +} + #else /* futures not enabled */ # define mz_prepare_direct_prim(n) mz_prepare(n) @@ -2275,6 +2261,23 @@ static void *ts_prepare_retry_alloc(void *p, void *p2) XFORM_SKIP_PROC (mz_direct_only(direct_only), first_arg, mz_finishr_direct_prim(reg, prim_indirect)) #endif +static Scheme_Object *_scheme_tail_apply_from_native_fixup_args(Scheme_Object *rator, + int argc, + Scheme_Object **argv) +{ + int already = fixup_already_in_place, i; + Scheme_Object **base; + + base = fixup_runstack_base XFORM_OK_MINUS argc XFORM_OK_MINUS already; + + /* Need to shift argc to end of base: */ + for (i = 0; i < argc; i++) { + base[already + i] = argv[i]; + } + + return ts__scheme_tail_apply_from_native(rator, argc + already, base); +} + static int generate_pause_for_gc_and_retry(mz_jit_state *jitter, int in_short_jumps, int gc_reg, /* must not be JIT_R1 */ @@ -2524,7 +2527,7 @@ static int generate_finish_tail_call(mz_jit_state *jitter, int direct_native) jit_pusharg_i(JIT_R0); jit_pusharg_p(JIT_V1); if (direct_native > 1) { /* => some_args_already_in_place */ - (void)mz_finish(ts__scheme_tail_apply_from_native_fixup_args); + (void)mz_finish(_scheme_tail_apply_from_native_fixup_args); } else { (void)mz_finish(ts__scheme_tail_apply_from_native); } diff --git a/src/mzscheme/src/jit_ts.c b/src/mzscheme/src/jit_ts.c index 1b778e1f7c..a43e0e5827 100644 --- a/src/mzscheme/src/jit_ts.c +++ b/src/mzscheme/src/jit_ts.c @@ -16,7 +16,6 @@ define_ts_siS_s(_scheme_apply_multi_from_native, FSRC_RATOR) define_ts_siS_s(_scheme_apply_from_native, FSRC_RATOR) define_ts_siS_s(_scheme_tail_apply_from_native, FSRC_RATOR) -define_ts_siS_s(_scheme_tail_apply_from_native_fixup_args, FSRC_RATOR) define_ts_s_s(scheme_force_value_same_mark, FSRC_OTHER) define_ts_s_s(scheme_force_one_value_same_mark, FSRC_OTHER) #if defined(INLINE_FP_OPS) && !defined(CAN_INLINE_ALLOC) diff --git a/src/mzscheme/src/jit_ts_future_glue.c b/src/mzscheme/src/jit_ts_future_glue.c index 0964d32c8e..a9cbc3fff5 100644 --- a/src/mzscheme/src/jit_ts_future_glue.c +++ b/src/mzscheme/src/jit_ts_future_glue.c @@ -16,11 +16,12 @@ future->arg_s0 = g44; future->arg_i1 = g45; future->arg_S2 = g46; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g47, Scheme_Object** g48, Scheme_Object* g49) @@ -41,11 +42,12 @@ future->arg_i0 = g47; future->arg_S1 = g48; future->arg_s2 = g49; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g50) @@ -64,11 +66,12 @@ future->source_of_request = who; future->source_type = src_type; future->arg_s0 = g50; + send_special_result(future, g50); future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Closure_Data* g51) @@ -87,11 +90,12 @@ future->source_of_request = who; future->source_type = src_type; future->arg_n0 = g51; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } Scheme_Object* scheme_rtcall__s(const char *who, int src_type, prim__s f ) @@ -110,11 +114,12 @@ future->source_of_request = who; future->source_type = src_type; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g52, Scheme_Object* g53) @@ -134,11 +139,12 @@ future->source_type = src_type; future->arg_s0 = g52; future->arg_s1 = g53; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g54, Scheme_Object* g55) @@ -158,6 +164,7 @@ future->source_type = src_type; future->arg_s0 = g54; future->arg_s1 = g55; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_m; @@ -182,11 +189,12 @@ future->source_type = src_type; future->arg_S0 = g56; future->arg_l1 = g57; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, long g58) @@ -205,11 +213,12 @@ future->source_of_request = who; future->source_type = src_type; future->arg_l0 = g58; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g59, Scheme_Object* g60, int g61) @@ -230,6 +239,7 @@ future->arg_b0 = g59; future->arg_s1 = g60; future->arg_i2 = g61; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; @@ -255,6 +265,7 @@ future->arg_i0 = g62; future->arg_i1 = g63; future->arg_S2 = g64; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; @@ -279,6 +290,7 @@ future->source_type = src_type; future->arg_s0 = g65; future->arg_s1 = g66; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; @@ -302,6 +314,7 @@ future->source_of_request = who; future->source_type = src_type; future->arg_b0 = g67; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; @@ -326,11 +339,12 @@ future->source_type = src_type; future->arg_s0 = g68; future->arg_l1 = g69; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g70, Scheme_Object** g71) @@ -350,11 +364,12 @@ future->source_type = src_type; future->arg_i0 = g70; future->arg_S1 = g71; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g72) @@ -373,11 +388,12 @@ future->source_of_request = who; future->source_type = src_type; future->arg_S0 = g72; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g73) @@ -396,6 +412,7 @@ future->source_of_request = who; future->source_type = src_type; future->arg_s0 = g73; + send_special_result(future, g73); future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; @@ -421,11 +438,12 @@ future->arg_i0 = g74; future->arg_S1 = g75; future->arg_i2 = g76; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_s; future->retval_s = 0; - receive_special_result(future, retval); + receive_special_result(future, retval, 1); return retval; } void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g77, int g78, Scheme_Object** g79) @@ -446,6 +464,7 @@ future->arg_s0 = g77; future->arg_i1 = g78; future->arg_S2 = g79; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; @@ -469,6 +488,7 @@ future->source_of_request = who; future->source_type = src_type; future->arg_z0 = g80; + future_do_runtimecall(fts, (void*)f, 0); future = fts->current_ft; retval = future->retval_p; diff --git a/src/mzscheme/src/jit_ts_runtime_glue.c b/src/mzscheme/src/jit_ts_runtime_glue.c index 6fa9143cb1..587134ab03 100644 --- a/src/mzscheme/src/jit_ts_runtime_glue.c +++ b/src/mzscheme/src/jit_ts_runtime_glue.c @@ -2,6 +2,7 @@ case SIG_siS_s: { prim_siS_s f = (prim_siS_s)future->prim_func; Scheme_Object* retval; + retval = f(future->arg_s0, future->arg_i1, future->arg_S2); future->retval_s = retval; @@ -12,6 +13,7 @@ case SIG_iSs_s: { prim_iSs_s f = (prim_iSs_s)future->prim_func; Scheme_Object* retval; + retval = f(future->arg_i0, future->arg_S1, future->arg_s2); future->retval_s = retval; @@ -22,6 +24,7 @@ case SIG_s_s: { prim_s_s f = (prim_s_s)future->prim_func; Scheme_Object* retval; + receive_special_result(future, future->arg_s0, 1); retval = f(future->arg_s0); future->retval_s = retval; @@ -32,6 +35,7 @@ case SIG_n_s: { prim_n_s f = (prim_n_s)future->prim_func; Scheme_Object* retval; + retval = f(future->arg_n0); future->retval_s = retval; @@ -42,6 +46,7 @@ case SIG__s: { prim__s f = (prim__s)future->prim_func; Scheme_Object* retval; + retval = f(); future->retval_s = retval; @@ -52,6 +57,7 @@ case SIG_ss_s: { prim_ss_s f = (prim_ss_s)future->prim_func; Scheme_Object* retval; + retval = f(future->arg_s0, future->arg_s1); future->retval_s = retval; @@ -62,6 +68,7 @@ case SIG_ss_m: { prim_ss_m f = (prim_ss_m)future->prim_func; MZ_MARK_STACK_TYPE retval; + retval = f(future->arg_s0, future->arg_s1); future->retval_m = retval; @@ -72,6 +79,7 @@ case SIG_Sl_s: { prim_Sl_s f = (prim_Sl_s)future->prim_func; Scheme_Object* retval; + retval = f(future->arg_S0, future->arg_l1); future->retval_s = retval; @@ -82,6 +90,7 @@ case SIG_l_s: { prim_l_s f = (prim_l_s)future->prim_func; Scheme_Object* retval; + retval = f(future->arg_l0); future->retval_s = retval; @@ -93,6 +102,7 @@ case SIG_bsi_v: prim_bsi_v f = (prim_bsi_v)future->prim_func; + f(future->arg_b0, future->arg_s1, future->arg_i2); @@ -103,6 +113,7 @@ case SIG_iiS_v: prim_iiS_v f = (prim_iiS_v)future->prim_func; + f(future->arg_i0, future->arg_i1, future->arg_S2); @@ -113,6 +124,7 @@ case SIG_ss_v: prim_ss_v f = (prim_ss_v)future->prim_func; + f(future->arg_s0, future->arg_s1); @@ -123,6 +135,7 @@ case SIG_b_v: prim_b_v f = (prim_b_v)future->prim_func; + f(future->arg_b0); @@ -132,6 +145,7 @@ case SIG_sl_s: { prim_sl_s f = (prim_sl_s)future->prim_func; Scheme_Object* retval; + retval = f(future->arg_s0, future->arg_l1); future->retval_s = retval; @@ -142,6 +156,7 @@ case SIG_iS_s: { prim_iS_s f = (prim_iS_s)future->prim_func; Scheme_Object* retval; + retval = f(future->arg_i0, future->arg_S1); future->retval_s = retval; @@ -152,6 +167,7 @@ case SIG_S_s: { prim_S_s f = (prim_S_s)future->prim_func; Scheme_Object* retval; + retval = f(future->arg_S0); future->retval_s = retval; @@ -162,6 +178,7 @@ case SIG_s_v: { prim_s_v f = (prim_s_v)future->prim_func; + receive_special_result(future, future->arg_s0, 1); f(future->arg_s0); @@ -172,6 +189,7 @@ case SIG_iSi_s: { prim_iSi_s f = (prim_iSi_s)future->prim_func; Scheme_Object* retval; + retval = f(future->arg_i0, future->arg_S1, future->arg_i2); future->retval_s = retval; @@ -183,6 +201,7 @@ case SIG_siS_v: prim_siS_v f = (prim_siS_v)future->prim_func; + f(future->arg_s0, future->arg_i1, future->arg_S2); @@ -192,6 +211,7 @@ case SIG_z_p: { prim_z_p f = (prim_z_p)future->prim_func; void* retval; + retval = f(future->arg_z0); future->retval_p = retval; diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index c319f39417..5ff15d2952 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -5482,6 +5482,7 @@ static int sequential_future_MARK(void *p) { gcMARK(f->orig_lambda); gcMARK(f->running_sema); gcMARK(f->retval); + gcMARK(f->multiple_array); return gcBYTES_TO_WORDS(sizeof(future_t)); } @@ -5491,6 +5492,7 @@ static int sequential_future_FIXUP(void *p) { gcFIXUP(f->orig_lambda); gcFIXUP(f->running_sema); gcFIXUP(f->retval); + gcFIXUP(f->multiple_array); return gcBYTES_TO_WORDS(sizeof(future_t)); } diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index 07c41debb4..e850efbb0b 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -2254,6 +2254,7 @@ sequential_future { gcMARK(f->orig_lambda); gcMARK(f->running_sema); gcMARK(f->retval); + gcMARK(f->multiple_array); size: gcBYTES_TO_WORDS(sizeof(future_t)); }