#include "schpriv.h"

#include "schmach.h"

static Scheme_Object *future_p(int argc, Scheme_Object *argv[])

{

if (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_future_type))

return scheme_true;

else

return scheme_false;

}

Scheme_Object *scheme_fsemaphore_p(int argc, Scheme_Object *argv[])

{

if (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_fsemaphore_type))

return scheme_true;

else

return scheme_false;

}

static Scheme_Object *futures_enabled(int argc, Scheme_Object *argv[])

{

#ifdef MZ_USE_FUTURES

return scheme_true;

#else

return scheme_false;

}

#ifdef MZ_PRECISE_GC

static void register_traversers(void);

#ifndef MZ_USE_FUTURES

typedef struct future_t {

} future_t;

typedef struct fsemaphore_t {

Scheme_Object so;

Scheme_Object *sema;

} fsemaphore_t;

Scheme_Object *scheme_future(int argc, Scheme_Object *argv[])

{

future_t *ft;

scheme_check_proc_arity("future", 0, 0, argc, argv);

ft = MALLOC_ONE_TAGGED(future_t);

ft->so.type = scheme_future_type;

ft->orig_lambda = argv[0];

return (Scheme_Object *)ft;

}

static Scheme_Object *touch(int argc, Scheme_Object *argv[])

{

future_t * volatile ft;

if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_future_type))

scheme_wrong_contract("touch", "future?", 0, argc, argv);

ft = (future_t *)argv[0];

while (1) {

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

if (ft->running_sema) {

scheme_wait_sema(ft->running_sema, 0);

scheme_post_sema(ft->running_sema);

} else {

Scheme_Object *sema;

future_t *old_ft;

mz_jmp_buf newbuf, * volatile savebuf;

Scheme_Thread *p = scheme_current_thread;

/* In case another Racket thread touches the future. */

sema = scheme_make_sema(0);

ft->running_sema = sema;

old_ft = p->current_ft;

p->current_ft = ft;

savebuf = p->error_buf;

p->error_buf = &newbuf;

if (scheme_setjmp(newbuf)) {

ft->no_retval = 1;

p->current_ft = old_ft;

scheme_post_sema(ft->running_sema);

scheme_longjmp(*savebuf, 1);

} else {

GC_CAN_IGNORE Scheme_Object *retval, *proc;

proc = ft->orig_lambda;

ft->orig_lambda = NULL; /* don't hold on to proc */

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->current_ft = old_ft;

p->error_buf = savebuf;

}

}

}

return NULL;

}

static Scheme_Object *processor_count(int argc, Scheme_Object *argv[])

{

return scheme_make_integer(1);

}

int scheme_is_multithreaded(int now)

{

return 0;

}

Scheme_Object *scheme_current_future(int argc, Scheme_Object *argv[])

{

future_t *ft = scheme_current_thread->current_ft;

return (ft ? (Scheme_Object *)ft : scheme_false);

}

Scheme_Object *scheme_make_fsemaphore(int argc, Scheme_Object *argv[])

{

intptr_t v;

fsemaphore_t *fsema;

Scheme_Object *sema;

v = scheme_get_semaphore_init("make-fsemaphore", argc, argv);

fsema = MALLOC_ONE_TAGGED(fsemaphore_t);

fsema->so.type = scheme_fsemaphore_type;

sema = scheme_make_sema(v);

fsema->sema = sema;

return (Scheme_Object*)fsema;

}

Scheme_Object *scheme_fsemaphore_post(int argc, Scheme_Object *argv[])

{

fsemaphore_t *fsema;

if (argc != 1 || !SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_fsemaphore_type))

scheme_wrong_contract("fsemaphore-post", "fsemaphore?", 0, argc, argv);

fsema = (fsemaphore_t*)argv[0];

scheme_post_sema(fsema->sema);

return scheme_void;

}

Scheme_Object *scheme_fsemaphore_wait(int argc, Scheme_Object *argv[])

{

fsemaphore_t *fsema;

if (argc != 1 || !SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_fsemaphore_type))

scheme_wrong_contract("fsemaphore-wait", "fsemaphore?", 0, argc, argv);

fsema = (fsemaphore_t*)argv[0];

scheme_wait_sema(fsema->sema, 0);

return scheme_void;

}

Scheme_Object *scheme_fsemaphore_try_wait(int argc, Scheme_Object *argv[])

{

fsemaphore_t *fsema;

if (argc != 1 || !SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_fsemaphore_type))

scheme_wrong_contract("fsemaphore-try-wait?", "fsemaphore?", 0, argc, argv);

fsema = (fsemaphore_t*)argv[0];

if (scheme_wait_sema(fsema->sema, 1))

return scheme_true;

return scheme_false;

}

Scheme_Object *scheme_fsemaphore_count(int argc, Scheme_Object *argv[])

{

fsemaphore_t *fsema;

if (argc != 1 || !SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_fsemaphore_type))

scheme_wrong_contract("fsemaphore-count", "fsemaphore?", 0, argc, argv);

fsema = (fsemaphore_t*)argv[0];

return scheme_make_integer(((Scheme_Sema *)fsema->sema)->value);

}

static Scheme_Object *would_be_future(int argc, Scheme_Object *argv[])

{

scheme_check_proc_arity("would-be-future", 0, 0, argc, argv);

return scheme_future(argc, argv);

}

static Scheme_Object *reset_future_logs_for_tracking(int argc, Scheme_Object *argv[])

{

return scheme_void;

}

static Scheme_Object *mark_future_trace_end(int argc, Scheme_Object *argv[])

{

return scheme_void;

}

# define FUTURE_PRIM_W_ARITY(name, func, a1, a2, env) GLOBAL_PRIM_W_ARITY(name, func, a1, a2, env)

void scheme_init_futures(Scheme_Env *newenv)

{

FUTURE_PRIM_W_ARITY("future?", future_p, 1, 1, newenv);

FUTURE_PRIM_W_ARITY("future", scheme_future, 1, 1, newenv);

FUTURE_PRIM_W_ARITY("processor-count", processor_count, 0, 0, newenv);

FUTURE_PRIM_W_ARITY("touch", touch, 1, 1, newenv);

FUTURE_PRIM_W_ARITY("current-future", scheme_current_future, 0, 0, newenv);

FUTURE_PRIM_W_ARITY("make-fsemaphore", scheme_make_fsemaphore, 1, 1, newenv);

FUTURE_PRIM_W_ARITY("fsemaphore?", scheme_fsemaphore_p, 1, 1, newenv);

FUTURE_PRIM_W_ARITY("fsemaphore-post", scheme_fsemaphore_post, 1, 1, newenv);

FUTURE_PRIM_W_ARITY("fsemaphore-wait", scheme_fsemaphore_wait, 1, 1, newenv);

FUTURE_PRIM_W_ARITY("fsemaphore-try-wait?", scheme_fsemaphore_try_wait, 1, 1, newenv);

FUTURE_PRIM_W_ARITY("fsemaphore-count", scheme_fsemaphore_count, 1, 1, newenv);

FUTURE_PRIM_W_ARITY("would-be-future", would_be_future, 1, 1, newenv);

FUTURE_PRIM_W_ARITY("futures-enabled?", futures_enabled, 0, 0, newenv);

FUTURE_PRIM_W_ARITY("reset-future-logs-for-tracing!", reset_future_logs_for_tracking, 0, 0, newenv);

GLOBAL_PRIM_W_ARITY("mark-future-trace-end!", mark_future_trace_end, 0, 0, newenv);

scheme_finish_primitive_module(newenv);

scheme_protect_primitive_provide(newenv, NULL);

#ifdef MZ_PRECISE_GC

register_traversers();

}

void scheme_init_futures_once()

{

}

void scheme_init_futures_per_place()

{

}

void scheme_end_futures_per_place()

{

}

#include "future.h"

#include <stdlib.h>

#include <string.h>

#include "jit.h"

#ifdef OS_X

# define CHECK_FUTURE_ASSERTS

#ifdef CHECK_FUTURE_ASSERTS

# include <assert.h>

# define FUTURE_ASSERT(x) assert(x)

# define FUTURE_ASSERT(x) /* empty */

static Scheme_Object *make_fsemaphore(int argc, Scheme_Object *argv[]);

static Scheme_Object *touch(int argc, Scheme_Object *argv[]);

static Scheme_Object *processor_count(int argc, Scheme_Object *argv[]);

static void futures_init(void);

static void init_future_thread(struct Scheme_Future_State *fs, int i);

static Scheme_Future_Thread_State *alloc_future_thread_state();

static void requeue_future(struct future_t *future, struct Scheme_Future_State *fs);

static void future_do_runtimecall(Scheme_Future_Thread_State *fts,

int for_overflow);

static int capture_future_continuation(struct Scheme_Future_State *fs, future_t *ft, void **storage,

int need_lock, int for_overflow);

#define FUTURE_C_STACK_SIZE 500000

#define FUTURE_RUNSTACK_SIZE 2000

#define FEVENT_BUFFER_SIZE 512

#define NO_FUTURE_ID -1

enum {

FEVENT_CREATE,

FEVENT_COMPLETE,

FEVENT_START_WORK,

FEVENT_START_RTONLY_WORK,

FEVENT_RESUME_WORK,

FEVENT_END_WORK,

FEVENT_RTCALL_ATOMIC,

FEVENT_HANDLE_RTCALL_ATOMIC,

FEVENT_RTCALL,

FEVENT_RTCALL_TOUCH,

FEVENT_HANDLE_RTCALL,

FEVENT_RTCALL_RESULT,

FEVENT_HANDLE_RTCALL_RESULT,

FEVENT_RTCALL_ABORT,

FEVENT_HANDLE_RTCALL_ABORT,

FEVENT_RTCALL_SUSPEND,

FEVENT_OVERFLOW,

FEVENT_TOUCH_PAUSE,

FEVENT_TOUCH_RESUME,

FEVENT_MISSING,

FEVENT_STOP_TRACE,

_FEVENT_COUNT_

};

static const char * const fevent_strs[] = { "create", "complete",

"start-work", "start-0-work", "start-overflow-work",

"end-work",

"sync", "sync", "block", "touch", "block",

"result", "result", "abort", "abort",

"suspend", "overflow",

"touch-pause", "touch-resume", "missing", "stop-trace" };

static const char * const fevent_long_strs[] = { "created", "completed",

"started work", "started (process 0, only)", "started (overflow)",

"ended work",

"synchronizing with process 0", "synchronizing",

"BLOCKING on process 0", "touching future", "HANDLING",

"result from process 0", "result determined",

"abort from process 0", "abort determined",

"suspended", "overflow",

"paused for touch", "resumed for touch",

"events missing", "stop future tracing" };

typedef struct Scheme_Future_State {

} Scheme_Future_State;

THREAD_LOCAL_DECL(static Scheme_Future_State *scheme_future_state);

THREAD_LOCAL_DECL(void *jit_future_storage[4]);

#ifdef MZ_PRECISE_GC

THREAD_LOCAL_DECL(extern uintptr_t GC_gen0_alloc_page_ptr);

THREAD_LOCAL_DECL(extern uintptr_t GC_gen0_alloc_page_end);

THREAD_LOCAL_DECL(extern int GC_gen0_alloc_only);

static void start_gc_not_ok(Scheme_Future_State *fs);

static void end_gc_not_ok(Scheme_Future_Thread_State *fts,

Scheme_Future_State *fs,

Scheme_Object **current_rs);

static void *worker_thread_future_loop(void *arg);

static void invoke_rtcall(Scheme_Future_State * volatile fs, future_t * volatile future, volatile int is_atomic);

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

static Scheme_Object *_apply_future_lw(future_t *ft);

static Scheme_Object *apply_future_lw(future_t *ft);

static int fsemaphore_ready(Scheme_Object *obj);

static void init_fevent(Fevent_Buffer *b);

static void free_fevent(Fevent_Buffer *b);

static int future_in_runtime(Scheme_Future_State *fs, future_t * volatile ft, int what);

static Scheme_Object *would_be_future(int argc, Scheme_Object *argv[]);

static void push_suspended_lw(Scheme_Future_State *fs, future_t *ft);

static void pop_suspended_lw(Scheme_Future_State *fs, future_t *ft);

static Scheme_Object *bad_multi_result_proc;

static Scheme_Object *bad_multi_result(int argc, Scheme_Object **argv);

static Scheme_Object *reset_future_logs_for_tracking(int argc, Scheme_Object *argv[]);

static Scheme_Object *mark_future_trace_end(int argc, Scheme_Object *argv[]);

READ_ONLY static int cpucount;

static void init_cpucount(void);

#ifdef MZ_PRECISE_GC

# define scheme_future_setjmp(newbuf) scheme_jit_setjmp((newbuf).jb)

# define scheme_future_longjmp(newbuf, v) scheme_jit_longjmp((newbuf).jb, v)

# define scheme_future_setjmp(newbuf) scheme_setjmp(newbuf)

# define scheme_future_longjmp(newbuf, v) scheme_longjmp(newbuf, v)

typedef struct future_thread_params_t {

} future_thread_params_t;

void scheme_init_futures(Scheme_Env *newenv)

{

Scheme_Object *p;

scheme_add_global_constant(

"future?",

scheme_make_folding_prim(

future_p,

"future?",

1,

1,

1),

newenv);

p = scheme_make_prim_w_arity(scheme_future, "future", 1, 1);

SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);

scheme_add_global_constant("future", p, newenv);

scheme_add_global_constant(

"processor-count",

scheme_make_prim_w_arity(

processor_count,

"processor-count",

0,

0),

newenv);

p = scheme_make_prim_w_arity(touch, "touch", 1, 1);

SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);

scheme_add_global_constant("touch", p, newenv);

p = scheme_make_immed_prim(

scheme_current_future,

"current-future",

0,

0);

SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);

scheme_add_global_constant("current-future", p, newenv);

p = scheme_make_immed_prim(

scheme_fsemaphore_p,

"fsemaphore?",

1,

1);

SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);

scheme_add_global_constant("fsemaphore?", p, newenv);

p = scheme_make_immed_prim(

make_fsemaphore,

"make-fsemaphore",

1,

1);

SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);

scheme_add_global_constant("make-fsemaphore", p, newenv);

p = scheme_make_immed_prim(

scheme_fsemaphore_count,

"fsemaphore-count",

1,

1);

SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);

scheme_add_global_constant("fsemaphore-count", p, newenv);

p = scheme_make_immed_prim(

scheme_fsemaphore_wait,

"fsemaphore-wait",

1,

1);

SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);

scheme_add_global_constant("fsemaphore-wait", p, newenv);

p = scheme_make_immed_prim(

scheme_fsemaphore_post,

"fsemaphore-post",

1,

1);

SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);

scheme_add_global_constant("fsemaphore-post", p, newenv);

p = scheme_make_immed_prim(

scheme_fsemaphore_try_wait,

"fsemaphore-try-wait?",

1,

1);

SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);

scheme_add_global_constant("fsemaphore-try-wait?", p, newenv);

GLOBAL_PRIM_W_ARITY("would-be-future", would_be_future, 1, 1, newenv);

GLOBAL_PRIM_W_ARITY("futures-enabled?", futures_enabled, 0, 0, newenv);

GLOBAL_PRIM_W_ARITY("reset-future-logs-for-tracing!", reset_future_logs_for_tracking, 0, 0, newenv);

GLOBAL_PRIM_W_ARITY("mark-future-trace-end!", mark_future_trace_end, 0, 0, newenv);

scheme_finish_primitive_module(newenv);

scheme_protect_primitive_provide(newenv, NULL);

}

void scheme_init_futures_once()

{

init_cpucount();

REGISTER_SO(bad_multi_result_proc);

bad_multi_result_proc = scheme_make_prim(bad_multi_result);

}

void scheme_init_futures_per_place()

{

futures_init();

}

static Scheme_Object *set_fts_thread(Scheme_Object *ignored)

{

scheme_future_thread_state->thread = scheme_current_thread;

return ignored;

}

void futures_init(void)

{

Scheme_Future_State *fs;

Scheme_Future_Thread_State *rt_fts;

Scheme_Future_Thread_State **ftss;

void *hand;

Scheme_Object **syms, *sym;

Scheme_Struct_Type *stype;

int pool_size;

fs = (Scheme_Future_State *)malloc(sizeof(Scheme_Future_State));

memset(fs, 0, sizeof(Scheme_Future_State));

scheme_future_state = fs;

pool_size = cpucount * 2;

ftss = (Scheme_Future_Thread_State **)malloc(pool_size * sizeof(Scheme_Future_Thread_State*));

memset(ftss, 0, pool_size * sizeof(Scheme_Future_Thread_State*));

fs->pool_threads = ftss;

fs->thread_pool_size = pool_size;

mzrt_mutex_create(&fs->future_mutex);

mzrt_sema_create(&fs->future_pending_sema, 0);

mzrt_sema_create(&fs->gc_ok_c, 0);

mzrt_sema_create(&fs->gc_done_c, 0);

fs->gc_counter_ptr = &scheme_did_gc_count;

/* Create a 'dummy' FTS for the RT thread */

rt_fts = alloc_future_thread_state();

rt_fts->is_runtime_thread = 1;

rt_fts->gen0_size = 1;

scheme_future_thread_state = rt_fts;

scheme_add_swap_callback(set_fts_thread, scheme_false);

set_fts_thread(scheme_false);

REGISTER_SO(fs->future_queue);

REGISTER_SO(fs->future_queue_end);

REGISTER_SO(fs->future_waiting_atomic);

REGISTER_SO(fs->future_waiting_lwc);

REGISTER_SO(fs->future_waiting_touch);

REGISTER_SO(fs->fevent_syms);

REGISTER_SO(fs->fevent_prefab);

REGISTER_SO(jit_future_storage);

hand = scheme_get_signal_handle();

fs->signal_handle = hand;

syms = MALLOC_N(Scheme_Object*, _FEVENT_COUNT_);

fs->fevent_syms = syms;

sym = scheme_intern_symbol(fevent_strs[FEVENT_HANDLE_RTCALL_ATOMIC]);

syms[FEVENT_HANDLE_RTCALL_ATOMIC] = sym;

sym = scheme_intern_symbol(fevent_strs[FEVENT_HANDLE_RTCALL]);

syms[FEVENT_HANDLE_RTCALL] = sym;

sym = scheme_intern_symbol("future-event");

stype = scheme_lookup_prefab_type(sym, 6);

fs->fevent_prefab = stype;

init_fevent(&fs->runtime_fevents);

#ifdef MZ_PRECISE_GC

register_traversers();

}

static void init_future_thread(Scheme_Future_State *fs, int i)

{

Scheme_Future_Thread_State *fts;

GC_CAN_IGNORE future_thread_params_t params;

Scheme_Thread *skeleton;

Scheme_Object **runstack_start;

mz_proc_thread *t;

/* Create the worker thread pool. These threads will

fts = alloc_future_thread_state();

fts->id = i;

fts->gen0_size = 1;

fts->use_fevents1 = 1;

init_fevent(&fts->fevents1);

init_fevent(&fts->fevents2);

params.shared_GC = GC_instance;

params.fts = fts;

params.fs = fs;

/* Make enough of a thread record to deal with multiple values. */

skeleton = MALLOC_ONE_TAGGED(Scheme_Thread);

skeleton->so.type = scheme_thread_type;

fts->thread = skeleton;

{

Scheme_Object **rs_start;

intptr_t init_runstack_size = FUTURE_RUNSTACK_SIZE;

rs_start = scheme_alloc_runstack(init_runstack_size);

runstack_start = rs_start;

fts->runstack_size = init_runstack_size;

}

/* Fill in GCable values just before creating the thread,

params.runstack_start = runstack_start;

mzrt_sema_create(&params.ready_sema, 0);

t = mz_proc_thread_create_w_stacksize(worker_thread_future_loop, &params, FUTURE_C_STACK_SIZE);

mzrt_sema_wait(params.ready_sema);

mzrt_sema_destroy(params.ready_sema);

params.ready_sema = NULL;

fts->t = t;

scheme_register_static(params.scheme_current_runstack_ptr, sizeof(void*));

scheme_register_static(params.scheme_current_runstack_start_ptr, sizeof(void*));

scheme_register_static(params.jit_future_storage_ptr, 4 * sizeof(void*));

scheme_register_static(params.current_thread_ptr, sizeof(void*));

fs->pool_threads[i] = fts;

}

static Scheme_Future_Thread_State *alloc_future_thread_state()

{

Scheme_Future_Thread_State *fts;

fts = (Scheme_Future_Thread_State *)malloc(sizeof(Scheme_Future_Thread_State));

memset(fts, 0, sizeof(Scheme_Future_Thread_State));

scheme_register_static(&fts->thread, sizeof(Scheme_Thread*));

return fts;

}

void scheme_end_futures_per_place()

{

Scheme_Future_State *fs = scheme_future_state;

if (fs) {

int i;

mzrt_mutex_lock(fs->future_mutex);

fs->abort_all_futures = 1;

fs->wait_for_gc = 1;

mzrt_mutex_unlock(fs->future_mutex);

/* post enough semas to ensure that every future

for (i = 0; i < fs->thread_pool_size; i++) {

if (fs->pool_threads[i]) {

mzrt_sema_post(fs->future_pending_sema);

mzrt_sema_post(fs->pool_threads[i]->worker_can_continue_sema);

}

}

scheme_future_block_until_gc();

/* wait for all future threads to end: */

for (i = 0; i < fs->thread_pool_size; i++) {

if (fs->pool_threads[i]) {

(void)mz_proc_thread_wait(fs->pool_threads[i]->t);

free_fevent(&fs->pool_threads[i]->fevents1);

free_fevent(&fs->pool_threads[i]->fevents2);

free(fs->pool_threads[i]);

}

}

free_fevent(&fs->runtime_fevents);

mzrt_mutex_destroy(fs->future_mutex);

mzrt_sema_destroy(fs->future_pending_sema);

mzrt_sema_destroy(fs->gc_ok_c);

mzrt_sema_destroy(fs->gc_done_c);

free(fs->pool_threads);

free(fs);

scheme_future_state = NULL;

}

}

static void check_future_thread_creation(Scheme_Future_State *fs)

{

if (!fs->future_threads_created && !fs->future_queue_count)

return;

if (fs->future_threads_created < fs->thread_pool_size) {

int count, busy;

mzrt_mutex_lock(fs->future_mutex);

count = fs->future_queue_count;

busy = fs->busy_thread_count;

mzrt_mutex_unlock(fs->future_mutex);

if (count >= (fs->future_threads_created - busy)) {

init_future_thread(fs, fs->future_threads_created);

fs->future_threads_created++;

}

}

}

static void start_gc_not_ok(Scheme_Future_State *fs)

{

while (fs->wait_for_gc) {

int quit = fs->abort_all_futures;

fs->need_gc_done_post++;

mzrt_mutex_unlock(fs->future_mutex);

if (quit) mz_proc_thread_exit(NULL);

mzrt_sema_wait(fs->gc_done_c);

mzrt_mutex_lock(fs->future_mutex);

}

fs->gc_not_ok++;

#ifdef MZ_PRECISE_GC

{

Scheme_Future_Thread_State *fts = scheme_future_thread_state;

if (fts->worker_gc_counter != *fs->gc_counter_ptr) {

GC_gen0_alloc_page_ptr = 0; /* forces future to ask for memory */

GC_gen0_alloc_page_end = 0;

fts->gen0_start = 0;

if (fts->gen0_size > 1)

fts->gen0_size >>= 1;

fts->worker_gc_counter = *fs->gc_counter_ptr;

}

}

}

static void end_gc_not_ok(Scheme_Future_Thread_State *fts,

Scheme_Future_State *fs,

Scheme_Object **current_rs)

{

Scheme_Thread *p;

scheme_set_runstack_limits(MZ_RUNSTACK_START,

fts->runstack_size,

(current_rs

? current_rs XFORM_OK_MINUS MZ_RUNSTACK_START

: fts->runstack_size),

fts->runstack_size);

p = scheme_current_thread;

p->runstack = MZ_RUNSTACK;

p->runstack_start = MZ_RUNSTACK_START;

p->cont_mark_stack = MZ_CONT_MARK_STACK;

p->cont_mark_pos = MZ_CONT_MARK_POS;

/* FIXME: clear scheme_current_thread->ku.multiple.array ? */

--fs->gc_not_ok;

if (fs->need_gc_ok_post) {

fs->need_gc_ok_post = 0;

mzrt_sema_post(fs->gc_ok_c);

}

}

void scheme_future_block_until_gc()

{

Scheme_Future_State *fs = scheme_future_state;

int i;

if (!fs) return;

if (!fs->future_threads_created) return;

mzrt_mutex_lock(fs->future_mutex);

fs->wait_for_gc = 1;

mzrt_mutex_unlock(fs->future_mutex);

for (i = 0; i < fs->thread_pool_size; i++) {

if (fs->pool_threads[i]) {

*(fs->pool_threads[i]->need_gc_pointer) = 1;

if (*(fs->pool_threads[i]->fuel_pointer)) {

*(fs->pool_threads[i]->fuel_pointer) = 0;

*(fs->pool_threads[i]->stack_boundary_pointer) += FUTURE_C_STACK_SIZE;

}

}

}

if (cpucount > 1) {

/* In principle, we need some sort of fence to ensure that future

#if defined(i386) || defined(__i386__) || defined(__x86_64) || defined(__x86_64__) || defined(__amd64__)

# ifdef _MSC_VER

{

int r[4];

__cpuid(r, 0);

}

{

# if defined(i386) || defined(__i386__)

# define MZ_PUSH_EBX "pushl %%ebx"

# define MZ_POP_EBX "popl %%ebx"

# if defined(__x86_64) || defined(__x86_64__) || defined(__amd64__)

# define MZ_PUSH_EBX "pushq %%rbx"

# define MZ_POP_EBX "popq %%rbx"

int _eax, _ebx, _ecx, _edx, op = 0;

/* we can't always use EBX, so save and restore it: */

asm (MZ_PUSH_EBX "\n\t"

"cpuid \n\t"

"movl %%ebx, %1 \n\t"

MZ_POP_EBX

: "=a" (_eax), "=r" (_ebx), "=c" (_ecx), "=d" (_edx) : "a" (op));

}

# undef MZ_PUSH_EBX

# undef MZ_POP_EBX

}

mzrt_mutex_lock(fs->future_mutex);

while (fs->gc_not_ok) {

fs->need_gc_ok_post = 1;

mzrt_mutex_unlock(fs->future_mutex);

mzrt_sema_wait(fs->gc_ok_c);

mzrt_mutex_lock(fs->future_mutex);

}

mzrt_mutex_unlock(fs->future_mutex);

}

void scheme_future_continue_after_gc()

{

Scheme_Future_State *fs = scheme_future_state;

int i;

if (!fs) return;

for (i = 0; i < fs->thread_pool_size; i++) {

if (fs->pool_threads[i]) {

*(fs->pool_threads[i]->need_gc_pointer) = 0;

if (!fs->pool_threads[i]->thread->current_ft

|| scheme_custodian_is_available(fs->pool_threads[i]->thread->current_ft->cust)) {

*(fs->pool_threads[i]->fuel_pointer) = 1;

*(fs->pool_threads[i]->stack_boundary_pointer) -= FUTURE_C_STACK_SIZE;

} else {

/* leave fuel exhausted, which will force the thread into a slow

}

}

}

mzrt_mutex_lock(fs->future_mutex);

fs->wait_for_gc = 0;

while (fs->need_gc_done_post) {

--fs->need_gc_done_post;

mzrt_sema_post(fs->gc_done_c);

}

mzrt_mutex_unlock(fs->future_mutex);

}

void scheme_future_gc_pause()

{

Scheme_Future_Thread_State *fts = scheme_future_thread_state;

Scheme_Future_State *fs = scheme_future_state;

mzrt_mutex_lock(fs->future_mutex);

end_gc_not_ok(fts, fs, MZ_RUNSTACK);

start_gc_not_ok(fs); /* waits until wait_for_gc is 0 */

mzrt_mutex_unlock(fs->future_mutex);

}

void scheme_future_check_custodians()

{

scheme_future_block_until_gc();

scheme_future_continue_after_gc();

}

int scheme_future_is_runtime_thread()

{

Scheme_Future_Thread_State *fts = scheme_future_thread_state;

return fts->is_runtime_thread;

}

static Scheme_Object *reset_future_logs_for_tracking(int argc, Scheme_Object **argv)

{

Scheme_Future_State *fs;

Scheme_Future_Thread_State *fts;

Scheme_Future_Thread_State *rt_fts;

fs = scheme_future_state;

rt_fts = scheme_future_thread_state;

if (fs) {

int i;

mzrt_mutex_lock(fs->future_mutex);

init_fevent(&fs->runtime_fevents);

if (rt_fts) {

init_fevent(&rt_fts->fevents1);

init_fevent(&rt_fts->fevents2);

rt_fts->use_fevents1 = 1;

}

for (i = 0; i < fs->thread_pool_size; i++) {

fts = fs->pool_threads[i];

if (fts) {

init_fevent(&fts->fevents1);