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

procedure-specialize: repair for literal syntax object

Browse Source 
Fix `procedure-specialize` for a procedure that refers to a
syntax-object literal. A syntax-object literal becomes part of the
procedure closure, but in a special way that nomrally allows syntax
objects to be loaded on demand. For now, specialization counts as
a demand of the syntax object.

Merge to v6.4
This commit is contained in:
Matthew Flatt 2016-01-17 16:17:45 -07:00
parent e0cc61d5af
commit 1204aacd70
2 changed files with 46 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

@ -5111,6 +5111,15 @@
(set! f f) (set! f f)
(test 12 ((f 10) 1))) (test 12 ((f 10) 1)))
(let ()
(define (f)
(procedure-specialize
(lambda ()
#'x)))
(set! f f)
(test #t syntax? ((f)))
(test 'x syntax-e ((f))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@ -453,6 +453,29 @@ Scheme_Object *scheme_extract_global(Scheme_Object *o, Scheme_Native_Closure *nc
return globs->a[pos]; return globs->a[pos];
} }
static Scheme_Object *extract_syntax(Scheme_Quote_Syntax *qs, Scheme_Native_Closure *nc)
{
/* GLOBAL ASSUMPTION: we assume that globals are the last thing
in the closure; grep for "GLOBAL ASSUMPTION" in fun.c. */
Scheme_Prefix *globs;
int i, pos;
Scheme_Object *v;
globs = (Scheme_Prefix *)nc->vals[nc->code->u2.orig_code->closure_size - 1];
i = qs->position;
pos = qs->midpoint;
v = globs->a[i+pos+1];
if (!v) {
v = globs->a[pos];
v = scheme_delayed_shift((Scheme_Object **)v, i);
globs->a[i+pos+1] = v;
}
return v;
}
static Scheme_Object *extract_closure_local(int pos, mz_jit_state *jitter, int get_constant) static Scheme_Object *extract_closure_local(int pos, mz_jit_state *jitter, int get_constant)
{ {
if (PAST_LIMIT()) return NULL; if (PAST_LIMIT()) return NULL;
@ -3281,15 +3304,22 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
mz_rs_sync(); mz_rs_sync();
if (SCHEME_NATIVE_CLOSURE_DATA_FLAGS(jitter->nc->code) & NATIVE_SPECIALIZED) {
Scheme_Object *stx;
stx = extract_syntax(qs, jitter->nc);
scheme_mz_load_retained(jitter, target, stx);
CHECK_LIMIT();
} else {
jit_movi_i(JIT_R0, WORDS_TO_BYTES(c)); jit_movi_i(JIT_R0, WORDS_TO_BYTES(c));
jit_movi_i(JIT_R1, (int)(intptr_t)&(((Scheme_Prefix *)0x0)->a[i + p + 1])); jit_movi_i(JIT_R1, (int)(intptr_t)&(((Scheme_Prefix *)0x0)->a[i + p + 1]));
jit_movi_i(JIT_R2, (int)(intptr_t)&(((Scheme_Prefix *)0x0)->a[p])); jit_movi_i(JIT_R2, (int)(intptr_t)&(((Scheme_Prefix *)0x0)->a[p]));
(void)jit_calli(sjc.quote_syntax_code); (void)jit_calli(sjc.quote_syntax_code);
CHECK_LIMIT(); CHECK_LIMIT();
if (target != JIT_R0) if (target != JIT_R0)
jit_movr_p(target, JIT_R0); jit_movr_p(target, JIT_R0);
} }
}
END_JIT_DATA(10); END_JIT_DATA(10);