diff --git a/src/mzscheme/src/future.c b/src/mzscheme/src/future.c index cf6ae59297..b10d589a2c 100644 --- a/src/mzscheme/src/future.c +++ b/src/mzscheme/src/future.c @@ -1003,6 +1003,12 @@ static void receive_special_result(future_t *f, Scheme_Object *retval) p->ku.multiple.array = f->multiple_array; p->ku.multiple.count = f->multiple_count; 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; } } @@ -1017,6 +1023,14 @@ 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; + } else if (SAME_OBJ(retval, SCHEME_TAIL_CALL_WAITING)) { + Scheme_Thread *p = scheme_current_thread; + + f->tail_rator = p->ku.apply.tail_rator; + f->tail_rands = p->ku.apply.tail_rands; + f->num_tail_rands = p->ku.apply.tail_num_rands; + p->ku.apply.tail_rator = NULL; + p->ku.apply.tail_rands = NULL; } } diff --git a/src/mzscheme/src/future.h b/src/mzscheme/src/future.h index 6b5007ff0b..2db66dfc7a 100644 --- a/src/mzscheme/src/future.h +++ b/src/mzscheme/src/future.h @@ -90,6 +90,10 @@ typedef struct future_t { Scheme_Object **multiple_array; int multiple_count; + Scheme_Object *tail_rator; + Scheme_Object **tail_rands; + int num_tail_rands; + Scheme_Object *retval; struct future_t *prev; struct future_t *next; diff --git a/src/mzscheme/src/gen-jit-ts.ss b/src/mzscheme/src/gen-jit-ts.ss index 428c41881c..e7413ce057 100644 --- a/src/mzscheme/src/gen-jit-ts.ss +++ b/src/mzscheme/src/gen-jit-ts.ss @@ -43,6 +43,7 @@ static @|result-type| ts_ ## id(@|args|) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ @|return| scheme_rtcall_@|t|(id, @(string-join arg-names ", ")); \ else \ diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index e75936874b..413b4e8db7 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -380,6 +380,12 @@ 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) @@ -3274,7 +3280,7 @@ static int generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_ && !(SCHEME_LOCAL_FLAGS(v) & SCHEME_LOCAL_OTHER_CLEARS)) { int pos; pos = mz_remap(SCHEME_LOCAL_POS(v)); - if (pos == (jitter->depth + args_already_in_place)) + if (pos == (jitter->depth + jitter->extra_pushed + args_already_in_place)) args_already_in_place++; else break; diff --git a/src/mzscheme/src/jit_ts_def.c b/src/mzscheme/src/jit_ts_def.c index 2d98325f88..838dadf60d 100644 --- a/src/mzscheme/src/jit_ts_def.c +++ b/src/mzscheme/src/jit_ts_def.c @@ -2,6 +2,7 @@ static Scheme_Object* ts_ ## id(Scheme_Object* g7, int g8, Scheme_Object** g9) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_siS_s(id, g7, g8, g9); \ else \ @@ -12,6 +13,7 @@ static Scheme_Object* ts_ ## id(Scheme_Object* g7, int g8, Scheme_Object** g9) \ static Scheme_Object* ts_ ## id(int g10, Scheme_Object** g11, Scheme_Object* g12) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_iSs_s(id, g10, g11, g12); \ else \ @@ -22,6 +24,7 @@ static Scheme_Object* ts_ ## id(int g10, Scheme_Object** g11, Scheme_Object* g12 static Scheme_Object* ts_ ## id(Scheme_Object* g13) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_s_s(id, g13); \ else \ @@ -32,6 +35,7 @@ static Scheme_Object* ts_ ## id(Scheme_Object* g13) \ static Scheme_Object* ts_ ## id(Scheme_Native_Closure_Data* g14) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_n_s(id, g14); \ else \ @@ -42,6 +46,7 @@ static Scheme_Object* ts_ ## id(Scheme_Native_Closure_Data* g14) \ static Scheme_Object* ts_ ## id() \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall__s(id, ); \ else \ @@ -52,6 +57,7 @@ static Scheme_Object* ts_ ## id() \ static Scheme_Object* ts_ ## id(Scheme_Object* g15, Scheme_Object* g16) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_ss_s(id, g15, g16); \ else \ @@ -62,6 +68,7 @@ static Scheme_Object* ts_ ## id(Scheme_Object* g15, Scheme_Object* g16) \ static MZ_MARK_STACK_TYPE ts_ ## id(Scheme_Object* g17, Scheme_Object* g18) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_ss_m(id, g17, g18); \ else \ @@ -72,6 +79,7 @@ static MZ_MARK_STACK_TYPE ts_ ## id(Scheme_Object* g17, Scheme_Object* g18) \ static Scheme_Object* ts_ ## id(Scheme_Object** g19, long g20) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_Sl_s(id, g19, g20); \ else \ @@ -82,6 +90,7 @@ static Scheme_Object* ts_ ## id(Scheme_Object** g19, long g20) \ static Scheme_Object* ts_ ## id(long g21) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_l_s(id, g21); \ else \ @@ -92,6 +101,7 @@ static Scheme_Object* ts_ ## id(long g21) \ static void ts_ ## id(Scheme_Bucket* g22, Scheme_Object* g23, int g24) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ scheme_rtcall_bsi_v(id, g22, g23, g24); \ else \ @@ -102,6 +112,7 @@ static void ts_ ## id(Scheme_Bucket* g22, Scheme_Object* g23, int g24) \ static void ts_ ## id(int g25, int g26, Scheme_Object** g27) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ scheme_rtcall_iiS_v(id, g25, g26, g27); \ else \ @@ -112,6 +123,7 @@ static void ts_ ## id(int g25, int g26, Scheme_Object** g27) \ static void ts_ ## id(Scheme_Object* g28, Scheme_Object* g29) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ scheme_rtcall_ss_v(id, g28, g29); \ else \ @@ -122,6 +134,7 @@ static void ts_ ## id(Scheme_Object* g28, Scheme_Object* g29) \ static void ts_ ## id(Scheme_Bucket* g30) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ scheme_rtcall_b_v(id, g30); \ else \ @@ -132,6 +145,7 @@ static void ts_ ## id(Scheme_Bucket* g30) \ static Scheme_Object* ts_ ## id(Scheme_Object* g31, long g32) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_sl_s(id, g31, g32); \ else \ @@ -142,6 +156,7 @@ static Scheme_Object* ts_ ## id(Scheme_Object* g31, long g32) \ static Scheme_Object* ts_ ## id(int g33, Scheme_Object** g34) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_iS_s(id, g33, g34); \ else \ @@ -152,6 +167,7 @@ static Scheme_Object* ts_ ## id(int g33, Scheme_Object** g34) \ static Scheme_Object* ts_ ## id(Scheme_Object** g35) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_S_s(id, g35); \ else \ @@ -162,6 +178,7 @@ static Scheme_Object* ts_ ## id(Scheme_Object** g35) \ static void ts_ ## id(Scheme_Object* g36) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ scheme_rtcall_s_v(id, g36); \ else \ @@ -172,6 +189,7 @@ static void ts_ ## id(Scheme_Object* g36) \ static Scheme_Object* ts_ ## id(int g37, Scheme_Object** g38, int g39) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_iSi_s(id, g37, g38, g39); \ else \ @@ -182,6 +200,7 @@ static Scheme_Object* ts_ ## id(int g37, Scheme_Object** g38, int g39) \ static void ts_ ## id(Scheme_Object* g40, int g41, Scheme_Object** g42) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ scheme_rtcall_siS_v(id, g40, g41, g42); \ else \ @@ -192,6 +211,7 @@ static void ts_ ## id(Scheme_Object* g40, int g41, Scheme_Object** g42) \ static void* ts_ ## id(size_t g43) \ { \ START_XFORM_SKIP; \ + LOG_PRIM_START(&id); \ if (scheme_use_rtcall) \ return scheme_rtcall_z_p(id, g43); \ else \ diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index 39d52678fe..db5cbca0e4 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -5434,6 +5434,8 @@ static int future_MARK(void *p) { gcMARK(f->retval_s); gcMARK(f->retval); gcMARK(f->multiple_array); + gcMARK(f->tail_rator); + gcMARK(f->tail_rands); gcMARK(f->prev); gcMARK(f->next); gcMARK(f->next_waiting_atomic); @@ -5457,6 +5459,8 @@ static int future_FIXUP(void *p) { gcFIXUP(f->retval_s); gcFIXUP(f->retval); gcFIXUP(f->multiple_array); + gcFIXUP(f->tail_rator); + gcFIXUP(f->tail_rands); gcFIXUP(f->prev); gcFIXUP(f->next); gcFIXUP(f->next_waiting_atomic); diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index b772e4f527..47c96e960c 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -2237,6 +2237,8 @@ future { gcMARK(f->retval_s); gcMARK(f->retval); gcMARK(f->multiple_array); + gcMARK(f->tail_rator); + gcMARK(f->tail_rands); gcMARK(f->prev); gcMARK(f->next); gcMARK(f->next_waiting_atomic);