From 86f0d75a969a006d16cdff61dda286444bb66ee6 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 18 Jan 2016 21:55:35 -0500 Subject: [PATCH] JIT: fix fast path for property-only chaperones The recently added fast path for property-only chaperones did not propagate the original object in the case that the property-only chaperone wraps a `chaperone-procedure*` chaprerone. Merge to v6.4 --- .../tests/racket/chaperone.rktl | 34 +++++++++++++++++++ racket/src/racket/src/fun.c | 24 ++++++++++--- racket/src/racket/src/jitcall.c | 15 +++++++- racket/src/racket/src/schnapp.inc | 5 ++- 4 files changed, 71 insertions(+), 7 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/chaperone.rktl b/pkgs/racket-test-core/tests/racket/chaperone.rktl index 3973f417c6..fe076c9fa2 100644 --- a/pkgs/racket-test-core/tests/racket/chaperone.rktl +++ b/pkgs/racket-test-core/tests/racket/chaperone.rktl @@ -2409,4 +2409,38 @@ ;; ---------------------------------------- +(let () + (define-values (->-c has-->c? get-->-c) + (make-impersonator-property '->-c)) + + (define-values (->-w has-->w? get-->-w) + (make-impersonator-property '->-w)) + + (define-values (prop:x x? x-ref) + (make-impersonator-property 'x)) + + (define (wrap-again function) + (chaperone-procedure* + function + #f + ->-w void + ->-c void)) + + (define (do-wrap f) + (chaperone-procedure* f + (λ (chap arg) + (test #t has-->w? chap) + (test #t has-->c? chap) + arg + (values (lambda (result) result) arg)))) + + (define wrapped-f (wrap-again (do-wrap (lambda (x) (+ x 1))))) + (define wrapped2-f (wrap-again (chaperone-procedure (do-wrap (lambda (x) (+ x 1))) #f prop:x 'x))) + (define (test-wrapped x) (x 19)) + (set! test-wrapped test-wrapped) + (test-wrapped wrapped-f) + (test-wrapped wrapped2-f)) + +;; ---------------------------------------- + (report-errs) diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index 5df7ce4863..abbcf8e0d5 100644 --- a/racket/src/racket/src/fun.c +++ b/racket/src/racket/src/fun.c @@ -3535,7 +3535,7 @@ static Scheme_Object *do_chaperone_procedure(const char *name, const char *whati int is_impersonator, int pass_self, int argc, Scheme_Object *argv[], int is_unsafe) { - Scheme_Chaperone *px; + Scheme_Chaperone *px, *px2; Scheme_Object *val = argv[0], *orig, *naya, *r, *app_mark; Scheme_Hash_Tree *props; @@ -3602,7 +3602,9 @@ static Scheme_Object *do_chaperone_procedure(const char *name, const char *whati Vector of odd size for redirects means a procedure chaperone, vector with even slots means a structure chaperone. A size of 5 (instead of 3) indicates that the wrapper - procedure accepts a "self" argument + procedure accepts a "self" argument. An immutable vector + means that it wraps a chaperone that wants the "self" + argument. If the known-good arity is #f, this means the chaperone wrapper defers directly to SCHEME_VEC_ELES(r)[0] and no @@ -3625,6 +3627,18 @@ static Scheme_Object *do_chaperone_procedure(const char *name, const char *whati if (is_unsafe || SCHEME_FALSEP(argv[1])) SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_PROC_CHAPERONE_CALL_DIRECT; + /* If there's a `pass_self` chaperone in px->prev, then we'll need + to pass the self proc along. */ + for (val = px->prev; SCHEME_P_CHAPERONEP(val); val = ((Scheme_Chaperone *)val)->prev) { + px2 = (Scheme_Chaperone *)val; + if (SCHEME_VECTORP(px2->redirects) && (SCHEME_VEC_SIZE(px2->redirects) & 0x1)) { + if ((SCHEME_VEC_SIZE(px2->redirects) > 3) + || SCHEME_IMMUTABLEP(px2->redirects)) + SCHEME_SET_IMMUTABLE(px->redirects); + break; + } + } + return (Scheme_Object *)px; } @@ -3884,7 +3898,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object if (SCHEME_CHAPERONE_FLAGS(px) & SCHEME_PROC_CHAPERONE_CALL_DIRECT) { simple_call = SCHEME_VEC_ELS(px->redirects)[0]; /* no redirection procedure */ - if (SCHEME_CHAPERONEP(simple_call)) { + if (SCHEME_IMMUTABLEP(px->redirects)) { /* communicate `self_proc` to the next layer: */ scheme_current_thread->self_for_proc_chaperone = self_proc; } @@ -4038,7 +4052,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object /* No filter for the result, so tail call: */ if (app_mark) scheme_set_cont_mark(SCHEME_CAR(app_mark), SCHEME_CDR(app_mark)); - if (SCHEME_CHAPERONEP(px->prev)) { + if (SCHEME_IMMUTABLEP(px->redirects)) { /* commuincate `self_proc` to the next layer: */ scheme_current_thread->self_for_proc_chaperone = self_proc; } @@ -4080,7 +4094,7 @@ Scheme_Object *scheme_apply_chaperone(Scheme_Object *o, int argc, Scheme_Object if (need_pop_mark) MZ_CONT_MARK_POS -= 2; - if (SCHEME_CHAPERONEP(px->prev)) { + if (SCHEME_IMMUTABLEP(px->redirects)) { /* commuincate `self_proc` to the next layer: */ scheme_current_thread->self_for_proc_chaperone = self_proc; } diff --git a/racket/src/racket/src/jitcall.c b/racket/src/racket/src/jitcall.c index a6b3df4b7c..66fcd11fe2 100644 --- a/racket/src/racket/src/jitcall.c +++ b/racket/src/racket/src/jitcall.c @@ -66,7 +66,7 @@ static Scheme_Object *clear_runstack(Scheme_Object **rs, intptr_t amt, Scheme_Ob static jit_insn *generate_proc_struct_retry(mz_jit_state *jitter, int num_rands, GC_CAN_IGNORE jit_insn *refagain) { GC_CAN_IGNORE jit_insn *ref2, *ref3, *refz1, *refz2, *refz3, *refz4, *refz5; - GC_CAN_IGNORE jit_insn *refz6, *refz7, *refz8, *refz9, *ref9; + GC_CAN_IGNORE jit_insn *refz6, *refz7, *refz8, *refz9, *ref9, *ref10; ref2 = jit_bnei_i(jit_forward(), JIT_R1, scheme_proc_struct_type); @@ -140,6 +140,19 @@ static jit_insn *generate_proc_struct_retry(mz_jit_state *jitter, int num_rands, ref9 = jit_beqi_p(jit_forward(), JIT_R2, scheme_false); refz9 = jit_bnei_p(jit_forward(), JIT_R2, scheme_make_integer(num_rands)); mz_patch_branch(ref9); + CHECK_LIMIT(); + /* If the vector is immutable, we need to provide the self proc, + if it's not provided already. The self proc is supplied through + a side channel in the thread record. */ + jit_ldxi_s(JIT_R2, JIT_R1, &MZ_OPT_HASH_KEY((Scheme_Inclhash_Object *)(0x0))); + ref9 = jit_bmci_i(jit_forward(), JIT_R2, 0x1); + (void)mz_tl_ldi_p(JIT_R2, tl_scheme_current_thread); + jit_ldxi_l(JIT_R1, JIT_R2, &((Scheme_Thread *)0x0)->self_for_proc_chaperone); + ref10 = jit_bnei_p(jit_forward(), JIT_R1, NULL); + jit_stxi_l(&((Scheme_Thread *)0x0)->self_for_proc_chaperone, JIT_R2, JIT_V1); + mz_patch_branch(ref10); + jit_ldxi_p(JIT_R1, JIT_V1, &((Scheme_Chaperone *)0x0)->redirects); + mz_patch_branch(ref9); /* Position [0] in SCHEME_VEC_ELS contains either the unwrapped function (if chaperone-procedure got #f for the proc argument) or the unsafe-chaperone diff --git a/racket/src/racket/src/schnapp.inc b/racket/src/racket/src/schnapp.inc index 0c78e42f22..2f9cc44d9e 100644 --- a/racket/src/racket/src/schnapp.inc +++ b/racket/src/racket/src/schnapp.inc @@ -68,7 +68,10 @@ Scheme_Object *PRIM_APPLY_NAME(Scheme_Object *rator, || SCHEME_INT_VAL(SCHEME_VEC_ELS(((Scheme_Chaperone *)rator)->redirects)[1]) == argc) { /* No redirection proc, i.e, chaperone is just for properties or produced by unsafe-chaperone-procedure result -- and in the - latter case, the arity is right.. */ + latter case, the arity is right. */ + GC_CAN_IGNORE Scheme_Thread *p = scheme_current_thread; + if (SCHEME_IMMUTABLEP(((Scheme_Chaperone *)rator)->redirects) && !p->self_for_proc_chaperone) + p->self_for_proc_chaperone = rator; rator = SCHEME_VEC_ELS(((Scheme_Chaperone *)rator)->redirects)[0]; t = _SCHEME_TYPE(rator); } else