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

repairs for procedure-spcialize

Browse Source
This commit is contained in:
Matthew Flatt 2019-07-08 07:36:40 -06:00
parent 003f0dd72e
commit 8e85441410
2 changed files with 49 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
pkgs/racket-test-core/tests/racket/procs.rktl
View File

@ -614,6 +614,35 @@
exn:fail:contract?
#rx"an even number of arguments")
;; ----------------------------------------
;; procedure-specialize
(let ([make-f (lambda (x)
(procedure-specialize
(lambda (y)
(cons x y))))])
(set! make-f make-f)
(test '(5 . 6) (make-f 5) 6))
(let ([make-f (lambda (x)
(lambda (y)
(cons x y)))])
(set! make-f make-f)
(let ([f (make-f 5)])
(test '(5 . 6) (procedure-specialize f) 6)
(test '(5 . 6) f 6)
(test '(7 . 8) (make-f 7) 8)))
(define top-level-variable-to-mutate-form-specialized 'no)
(let ([f (procedure-specialize
(lambda (y)
(set! top-level-variable-to-mutate-form-specialized 'yes)
y))])
(set! f f)
(test 'done f 'done)
(test 'yes values top-level-variable-to-mutate-form-specialized))
;; ----------------------------------------
(report-errs)

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

@ -2423,12 +2423,18 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
mz_rs_sync();
if (SAME_TYPE(SCHEME_TYPE(v), scheme_toplevel_type)) {
/* Load prefix: */
pos = mz_remap(SCHEME_TOPLEVEL_DEPTH(v));
mz_rs_ldxi(JIT_R2, pos);
/* Extract bucket from prefix: */
pos = SCHEME_TOPLEVEL_POS(v);
jit_ldxi_p(JIT_R2, JIT_R2, &(((Scheme_Prefix *)0x0)->a[pos]));
if (jitter->nc && (SCHEME_NATIVE_LAMBDA_FLAGS(jitter->nc->code) & NATIVE_SPECIALIZED)) {
Scheme_Object *b;
b = scheme_extract_global(v, jitter->nc, 0);
scheme_mz_load_retained(jitter, JIT_R2, b);
} else {
/* Load prefix: */
pos = mz_remap(SCHEME_TOPLEVEL_DEPTH(v));
mz_rs_ldxi(JIT_R2, pos);
/* Extract bucket from prefix: */
pos = SCHEME_TOPLEVEL_POS(v);
jit_ldxi_p(JIT_R2, JIT_R2, &(((Scheme_Prefix *)0x0)->a[pos]));
}
} else {
/* Load bucket */
v = SCHEME_STATIC_TOPLEVEL_PREFIX(v)->a[SCHEME_TOPLEVEL_POS(v)];
@ -3984,7 +3990,7 @@ static void on_demand_generate_lambda(Scheme_Native_Closure *nc, Scheme_Native_L
Scheme_Lambda *lam;
Generate_Lambda gdata;
void *start_code, *tail_code, *arity_code;
int max_depth;
int max_depth, ns;
lam = nlam->u2.orig_code;
@ -4010,7 +4016,8 @@ static void on_demand_generate_lambda(Scheme_Native_Closure *nc, Scheme_Native_L
abort();
}
if (SCHEME_NATIVE_LAMBDA_FLAGS(nlam) & NATIVE_SPECIALIZED)
ns = SCHEME_NATIVE_LAMBDA_FLAGS(nlam) & NATIVE_SPECIALIZED;
if (ns)
SCHEME_NATIVE_LAMBDA_FLAGS(nlam) -= NATIVE_SPECIALIZED;
if (SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_PRESERVES_MARKS)
@ -4042,10 +4049,12 @@ static void on_demand_generate_lambda(Scheme_Native_Closure *nc, Scheme_Native_L
max_depth = gdata.max_tail_depth;
/* max_let_depth is used for flags by generate_lambda: */
if (nlam->max_let_depth & 0x1) {
lam->body = NULL;
if (!ns) {
if (nlam->max_let_depth & 0x1) {
lam->body = NULL;
}
lam->context = NULL;
}
lam->context = NULL;
if (nlam->max_let_depth & 0x2) {
Scheme_Native_Lambda *case_lam;
case_lam = ((Scheme_Native_Lambda_Plus_Case *)nlam)->case_lam;