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

JIT: fix allocation of came-lambda closures over flonums

Browse Source 
Also, clean up code and assumptions related to fixnum-producing
functions and unboxing (not related to the bug).
This commit is contained in:
Matthew Flatt 2012-11-23 08:15:03 -07:00
parent 961f5e40bf
commit 4e0fac0477
3 changed files with 41 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/tests/racket/optimize.rktl
View File

@ -2589,6 +2589,20 @@
(f)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; check a `case-lambda' that closes over flonums
(let ()
(define f #f)
(set! f
(lambda (x)
(let ([x (fl+ x x)])
(case-lambda
[() (fl+ x x)]
[(y) (fl+ x y)]))))
(test 4.0 (f 1.0) 2.0))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

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

@ -1324,6 +1324,19 @@ static int generate_case_closure(Scheme_Object *obj, mz_jit_state *jitter, int t
ensure_case_closure_native(c);
ndata = c->native_code;
count = c->count;
for (i = 0; i < count; i++) {
o = c->array[i];
if (SCHEME_PROCP(o))
o = (Scheme_Object *)((Scheme_Closure *)o)->code;
data = (Scheme_Closure_Data *)o;
mz_rs_sync();
CHECK_LIMIT();
generate_closure_prep(data, jitter);
CHECK_LIMIT();
}
mz_rs_sync();
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
@ -1337,8 +1350,6 @@ static int generate_case_closure(Scheme_Object *obj, mz_jit_state *jitter, int t
jit_retval(JIT_R1);
CHECK_LIMIT();
count = c->count;
for (i = 0; i < count; i++) {
o = c->array[i];
if (SCHEME_PROCP(o))
@ -1514,7 +1525,7 @@ int scheme_generate_non_tail(Scheme_Object *obj, mz_jit_state *jitter,
}
int scheme_generate_unboxed(Scheme_Object *obj, mz_jit_state *jitter, int inlined_ok, int unbox_anyway)
/* de-sync's; if refslow, failure jumps conditionally with non-flonum in R0;
/* de-sync's;
inlined_ok == 2 => can generate directly; inlined_ok == 1 => non-tail unbox */
{
int saved;
@ -2844,12 +2855,13 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
if (scheme_can_unbox_inline(lv->value, 5, JIT_FPR_NUM-1, 0)) {
jitter->unbox++;
scheme_generate_unboxed(lv->value, jitter, 2, 0);
} else {
if (0) /* validator should ensure that this is ok */
if (!scheme_can_unbox_directly(lv->value))
scheme_signal_error("internal error: bad FLONUM annotation on let");
} else if (scheme_can_unbox_directly(lv->value)) {
jitter->unbox++;
scheme_generate_unboxed(lv->value, jitter, 1, 0);
} else {
/* validator should ensure that this is ok */
jitter->unbox++;
scheme_generate_unboxed(lv->value, jitter, 0, 1);
}
#endif
} else if (unused && SCHEME_FALSEP(lv->value)) {

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

@ -50,13 +50,18 @@ static int can_reorder_unboxing(Scheme_Object *rand, Scheme_Object *rand2)
}
static int is_inline_unboxable_op(Scheme_Object *obj, int flag, int unsafely, int just_checking_result)
/* If unsafely, a result f 2 means that arguments should be checked safely. */
/* If unsafely, a result of 2 means that arguments should be checked safely. */
{
if (!SCHEME_PRIMP(obj))
return 0;
if (!(SCHEME_PRIM_PROC_OPT_FLAGS(obj) & flag))
return 0;
/* We have a table here for now, instead of flags accessed via
SCHEME_PRIM_PROC_OPT_FLAGS(), because this function reports
properties of the JIT rather than inherent properties of the
functions. */
if (IS_NAMED_PRIM(obj, "unsafe-fl+")) return 1;
if (IS_NAMED_PRIM(obj, "unsafe-fl-")) return 1;
if (IS_NAMED_PRIM(obj, "unsafe-fl*")) return 1;
@ -209,7 +214,8 @@ int scheme_can_unbox_inline(Scheme_Object *obj, int fuel, int regs, int unsafely
int scheme_can_unbox_directly(Scheme_Object *obj)
/* Used only when !can_unbox_inline(). Detects safe operations that
produce flonums when they don't raise an exception. */
produce flonums when they don't raise an exception, and that the JIT
supports directly unboxing. */
{
Scheme_Type t;