fix JIT handling of struct type property predicates and accessors

When the JIT guesses that a rator will always be a struct type
property or accessor, the run-time check to confirm that guess
was broken.
This commit is contained in:
Matthew Flatt 2017-01-27 07:51:54 -07:00
parent 420330fef0
commit 89512edad9
2 changed files with 48 additions and 1 deletions

View File

@ -927,6 +927,46 @@
(test #t eval '(equal? (refine-letter letter) (paper 99 11 0)))
(test #t eval '(equal? (refine-letter formal-letter) (paper 99 11 0))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure the JIT handles struct-type property predicates and
;; accessors correctly, including distinguishing them from structure
;; predicates
(define (apply-a-predicate x pred)
(if (pred x)
'(1)
'(2)))
(define (apply-an-accessor x acc)
(cons (acc x) '(=)))
(let ()
(define-values (prop:x x? x-ref) (make-struct-type-property 'x))
(struct chi ()
#:property prop:x 3)
(test '(1) apply-a-predicate (chi) x?)
(test '(3 =) apply-an-accessor (chi) x-ref)
(struct alpha (a))
(struct beta (b)
#:property prop:procedure (lambda (v) #t))
(test '(1) apply-a-predicate (alpha 'a) alpha?)
(test '(1) apply-a-predicate (beta 'b) beta?)
(test '(a =) apply-an-accessor (alpha 'a) alpha-a)
(test '(b =) apply-an-accessor (beta 'b) beta-b)
(test '(#t =) apply-an-accessor (alpha 'a) alpha?)
(test '(#t =) apply-an-accessor (beta 'b) beta?)
(test '(#f =) apply-an-accessor (alpha 'a) beta?)
(test '(#f =) apply-an-accessor (beta 'b) alpha?)
(test '(2) apply-a-predicate (alpha 'a) x?)
(test '(2) apply-a-predicate (beta 'b) x?)
(test '(#f =) apply-an-accessor (alpha 'a) x?)
(test '(#f =) apply-an-accessor (beta 'b) x?))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

View File

@ -2027,6 +2027,7 @@ static int common4b(mz_jit_state *jitter, void *_data)
for (ii = 0; ii < 3; ii++) { /* single, multi, or tail */
void *code;
GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *refno, *refslow, *refloop;
int prim_other_type;
code = jit_get_ip();
@ -2037,6 +2038,7 @@ static int common4b(mz_jit_state *jitter, void *_data)
sjc.struct_prop_get_multi_code = code;
else
sjc.struct_prop_get_code = code;
prim_other_type = SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER;
} else if (i == 1) {
if (ii == 2)
sjc.struct_prop_get_defl_tail_code = code;
@ -2044,6 +2046,7 @@ static int common4b(mz_jit_state *jitter, void *_data)
sjc.struct_prop_get_defl_multi_code = code;
else
sjc.struct_prop_get_defl_code = code;
prim_other_type = SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER;
} else if (i == 2) {
if (ii == 2)
sjc.struct_prop_pred_tail_code = code;
@ -2051,6 +2054,7 @@ static int common4b(mz_jit_state *jitter, void *_data)
sjc.struct_prop_pred_multi_code = code;
else
sjc.struct_prop_pred_code = code;
prim_other_type = SCHEME_PRIM_STRUCT_TYPE_STRUCT_PROP_PRED;
}
mz_prolog(JIT_R2);
@ -2110,9 +2114,12 @@ static int common4b(mz_jit_state *jitter, void *_data)
mz_patch_branch(ref);
(void)mz_bnei_t(refslow, JIT_R0, scheme_prim_type, JIT_R2);
jit_ldxi_s(JIT_R2, JIT_R0, &((Scheme_Primitive_Proc *)0x0)->pp.flags);
(void)jit_bmci_i(refslow, JIT_R2, SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER);
jit_andi_i(JIT_R2, JIT_R2, SCHEME_PRIM_OTHER_TYPE_MASK);
(void)jit_bnei_i(refslow, JIT_R2, prim_other_type);
CHECK_LIMIT();
jit_jmpi(refslow);
/* Check argument: */
(void)jit_bmsi_ul(refno, JIT_R1, 0x1);
jit_ldxi_s(JIT_R2, JIT_R1, &((Scheme_Object *)0x0)->type);