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

futures: fix `future' when given a non-JITted procedure

Browse Source 
Merge to 5.1
This commit is contained in:
Matthew Flatt 2011-02-05 06:42:08 -07:00
parent 7579b48791
commit da6d4f3fba
2 changed files with 27 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/tests/future/future.rkt
View File

@ -202,3 +202,15 @@ We should also test deep continuations.
(future (lambda ()
(and (eq? (touch f) f)
(current-future)))))))
;; Make sure that `future' doesn't mishandle functions
;; that aren't be JITted:
(check-equal?
(for/list ([i (in-range 10)]) (void))
(map
touch
(for/list ([i (in-range 10)])
(if (even? i)
(future void)
(future (parameterize ([eval-jit-enabled #f])
(eval #'(lambda () (void)))))))))

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

@ -642,8 +642,13 @@ Scheme_Object *scheme_future(int argc, Scheme_Object *argv[])
}
}
nc = (Scheme_Native_Closure*)lambda;
ncd = nc->code;
if (SAME_TYPE(SCHEME_TYPE(lambda), scheme_native_closure_type)) {
nc = (Scheme_Native_Closure*)lambda;
ncd = nc->code;
} else {
nc = NULL;
ncd = NULL;
}
/* Create the future descriptor and add to the queue as 'pending' */
ft = MALLOC_ONE_TAGGED(future_t);
@ -655,17 +660,18 @@ Scheme_Object *scheme_future(int argc, Scheme_Object *argv[])
ft->status = PENDING;
/* JIT the code if not already JITted */
if (ncd->code == scheme_on_demand_jit_code)
{
if (ncd) {
if (ncd->code == scheme_on_demand_jit_code)
scheme_on_demand_generate_lambda(nc, 0, NULL);
if (ncd->max_let_depth > FUTURE_RUNSTACK_SIZE * sizeof(void*)) {
/* Can't even call it in a future thread */
ft->status = PENDING_OVERSIZE;
}
if (ncd->max_let_depth > FUTURE_RUNSTACK_SIZE * sizeof(void*)) {
/* Can't even call it in a future thread */
ft->code = (void*)ncd->code;
} else
ft->status = PENDING_OVERSIZE;
}
ft->code = (void*)ncd->code;
if (ft->status != PENDING_OVERSIZE) {
mzrt_mutex_lock(fs->future_mutex);