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

JIT-inline struct type property predicates and accessors

Browse Source
This commit is contained in:
Matthew Flatt 2011-06-11 07:55:24 -07:00
parent ecf45ab426
commit 80c4396dc1
7 changed files with 246 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/scribblings/reference/struct.scrbl
View File

@ -314,11 +314,11 @@ Creates a new structure type property and returns three values:
one of its instances; if the structure type does not have a
value for the property, or if any other kind of value is
provided, the @exnraise[exn:fail:contract] unless a second
argument, @racket[failure-result], is supplied to the
procedure. In that case, if @racket[failure-result] is a
argument, @racket[_failure-result], is supplied to the
procedure. In that case, if @racket[_failure-result] is a
procedure, it is called (through a tail call) with no arguments
to produce the result of the property accessor procedure;
otherwise, @racket[failure-result] is itself returned as the
otherwise, @racket[_failure-result] is itself returned as the
result.}
]

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

@ -14,7 +14,13 @@
[eval-jit-enabled #t])
(namespace-require 'racket/flonum)
(namespace-require 'racket/fixnum)
(let* ([check-error-message (lambda (name proc [fixnum? #f])
(eval '(define-values (prop:thing thing? thing-ref)
(make-struct-type-property 'thing)))
(eval '(struct rock (x) #:property prop:thing 'yes))
(let* ([struct:rock (eval 'struct:rock)]
[a-rock (eval '(rock 0))]
[chap-rock (eval '(chaperone-struct (rock 0) rock-x (lambda (r v) (add1 v))))]
[check-error-message (lambda (name proc [fixnum? #f])
(unless (memq name '(eq? eqv? equal?
not null? pair? list?
real? number? boolean?
@ -24,7 +30,8 @@
eof-object?
exact-integer?
exact-nonnegative-integer?
exact-positive-integer?))
exact-positive-integer?
thing?))
(let ([s (with-handlers ([exn? exn-message])
(proc (if fixnum? 10 'bad)))]
[name (symbol->string name)])
@ -172,6 +179,10 @@
(un #f 'string? #"apple")
(un #f 'bytes? "apple")
(un #t 'bytes? #"apple")
(un #f 'thing? 10)
(un #t 'thing? a-rock)
(un #t 'thing? chap-rock)
(un #t 'thing? struct:rock)
(bin #f 'eq? 0 10)
(bin-exact #t 'eq? 10 10)
@ -651,6 +662,10 @@
(bin-exact #f 'procedure-arity-includes? (lambda (x) x) 2)
(bin-exact #t 'procedure-arity-includes? (lambda x x) 2)
(un0 'yes 'thing-ref a-rock)
(bin0 'yes 'thing-ref a-rock 99)
(bin0 99 'thing-ref 10 99)
))
(define (comp=? c1 c2)

2
src/racket/include/scheme.h
View File

@ -650,7 +650,7 @@ typedef struct Scheme_Offset_Cptr
#define SCHEME_PRIM_TYPE_PARAMETER 64
#define SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER (64 | 128)
#define SCHEME_PRIM_SOMETIMES_INLINED (64 | 256)
/* combination still available: 64|128|256 */
#define SCHEME_PRIM_TYPE_STRUCT_PROP_PRED (64 | 128 | 256)
#define SCHEME_PRIM_IS_STRUCT_PROC (SCHEME_PRIM_IS_STRUCT_INDEXED_GETTER | SCHEME_PRIM_IS_STRUCT_PRED | SCHEME_PRIM_IS_STRUCT_OTHER)

3
src/racket/src/jit.h
View File

@ -232,6 +232,9 @@ struct scheme_jit_common_record {
void *struct_pred_branch_code;
void *struct_get_code, *struct_get_multi_code;
void *struct_set_code, *struct_set_multi_code;
void *struct_prop_get_code, *struct_prop_get_multi_code;
void *struct_prop_get_defl_code, *struct_prop_get_defl_multi_code;
void *struct_prop_pred_code, *struct_prop_pred_multi_code;
void *struct_proc_extract_code;
void *bad_app_vals_target;
void *app_values_slow_code, *app_values_multi_slow_code, *app_values_tail_slow_code;

169
src/racket/src/jitcommon.c
View File

@ -1503,6 +1503,174 @@ static int common4(mz_jit_state *jitter, void *_data)
return 1;
}
static int common4b(mz_jit_state *jitter, void *_data)
{
int i, ii;
/* *** struct_prop_{pred,get[_defl]}_[multi_]code *** */
/* R0 is (potential) struct-prop proc, R1 is (potential) struct.
If defl_, V1 is second argument for default value. */
for (i = 0; i < 3; i++) {
for (ii = 0; ii < 2; ii++) {
void *code;
GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *refno, *refslow, *refloop, *refrts;
code = jit_get_ip().ptr;
if (i == 0) {
if (ii == 1)
sjc.struct_prop_get_multi_code = code;
else
sjc.struct_prop_get_code = code;
} else if (i == 1) {
if (ii == 1)
sjc.struct_prop_get_defl_multi_code = code;
else
sjc.struct_prop_get_defl_code = code;
} else if (i == 2) {
if (ii == 1)
sjc.struct_prop_pred_multi_code = code;
else
sjc.struct_prop_pred_code = code;
}
mz_prolog(JIT_R2);
if (i == 1) {
/* push second argument now, since we don't have a better
place to keep it */
jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(1));
jit_str_p(JIT_RUNSTACK, JIT_V1);
}
__START_SHORT_JUMPS__(1);
ref = jit_bmci_ul(jit_forward(), JIT_R0, 0x1);
CHECK_LIMIT();
/* Slow path: non-struct-prop proc, or argument type is
bad for a getter. */
refslow = _jit.x.pc;
jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(1));
CHECK_RUNSTACK_OVERFLOW();
JIT_UPDATE_THREAD_RSPTR();
jit_str_p(JIT_RUNSTACK, JIT_R1);
jit_movi_i(JIT_V1, ((i == 1) ? 2 : 1));
jit_prepare(3);
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_i(JIT_V1);
jit_pusharg_p(JIT_R0);
if (ii == 1) {
(void)mz_finish_lwe(ts__scheme_apply_multi_from_native, refrts);
} else {
(void)mz_finish_lwe(ts__scheme_apply_from_native, refrts);
}
jit_retval(JIT_R0);
VALIDATE_RESULT(JIT_R0);
if (ii == 1) {
/* second argument was pushed early */
jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(2));
} else {
jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(1));
}
JIT_UPDATE_THREAD_RSPTR();
mz_epilog(JIT_V1);
CHECK_LIMIT();
if (i == 2) {
refno = _jit.x.pc;
jit_movi_p(JIT_R0, scheme_false);
mz_epilog(JIT_V1);
CHECK_LIMIT();
} else
refno = refslow;
/* Continue trying fast path: check proc */
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);
CHECK_LIMIT();
/* Check argument: */
(void)jit_bmsi_ul(refno, JIT_R1, 0x1);
jit_ldxi_s(JIT_R2, JIT_R1, &((Scheme_Object *)0x0)->type);
__START_INNER_TINY__(1);
ref2 = jit_beqi_i(jit_forward(), JIT_R2, scheme_structure_type);
__END_INNER_TINY__(1);
if (i == 2) {
(void)jit_beqi_i(refslow, JIT_R2, scheme_proc_chaperone_type);
(void)jit_beqi_i(refslow, JIT_R2, scheme_chaperone_type);
(void)jit_beqi_i(refslow, JIT_R2, scheme_struct_type_type);
}
(void)jit_bnei_i(refno, JIT_R2, scheme_proc_struct_type);
__START_INNER_TINY__(1);
mz_patch_branch(ref2);
__END_INNER_TINY__(1);
CHECK_LIMIT();
/* Put argument struct type in R2, array prop count in V1: */
jit_ldxi_p(JIT_R2, JIT_R1, &((Scheme_Structure *)0x0)->stype);
jit_ldxi_i(JIT_V1, JIT_R2, &((Scheme_Struct_Type *)0x0)->num_props);
CHECK_LIMIT();
/* negative count means use the hash table (in the slow path);
zero count means we've run out */
if (i == 2) {
(void)jit_blei_i(refslow, JIT_V1, 0);
}
refloop = _jit.x.pc;
(void)jit_blei_i(refno, JIT_V1, 0);
jit_subi_i(JIT_V1, JIT_V1, 1);
mz_set_local_p(JIT_V1, JIT_LOCAL3);
jit_ldxi_p(JIT_R2, JIT_R1, &((Scheme_Structure *)0x0)->stype);
jit_ldxi_p(JIT_R2, JIT_R2, &((Scheme_Struct_Type *)0x0)->props);
jit_lshi_ul(JIT_V1, JIT_V1, JIT_LOG_WORD_SIZE);
jit_ldxr_p(JIT_R2, JIT_R2, JIT_V1);
/* extract car of table entry, which is the key: */
(void)jit_ldxi_p(JIT_R2, JIT_R2, &((Scheme_Simple_Object *)0x0)->u.pair_val.car);
CHECK_LIMIT();
/* target struct-type property in V1 */
jit_ldxi_p(JIT_V1, JIT_R0, &((Scheme_Primitive_Closure *)0x0)->val);
ref3 = jit_beqr_p(jit_forward(), JIT_R2, JIT_V1);
mz_get_local_p(JIT_V1, JIT_LOCAL3);
jit_jmpi(refloop);
/* Success! */
mz_patch_branch(ref3);
if (i == 2) {
jit_movi_p(JIT_R0, scheme_true);
} else {
if (i == 1) {
/* pop second argument, which we don't need */
jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(1));
}
/* same as above, but get the cdr this time: */
mz_get_local_p(JIT_V1, JIT_LOCAL3);
jit_ldxi_p(JIT_R2, JIT_R1, &((Scheme_Structure *)0x0)->stype);
jit_ldxi_p(JIT_R2, JIT_R2, &((Scheme_Struct_Type *)0x0)->props);
jit_lshi_ul(JIT_V1, JIT_V1, JIT_LOG_WORD_SIZE);
jit_ldxr_p(JIT_R2, JIT_R2, JIT_V1);
(void)jit_ldxi_p(JIT_R0, JIT_R2, &((Scheme_Simple_Object *)0x0)->u.pair_val.cdr);
}
CHECK_LIMIT();
mz_epilog(JIT_V1);
__END_SHORT_JUMPS__(1);
scheme_jit_register_sub_func(jitter, code, scheme_false);
}
}
return 1;
}
static int common5(mz_jit_state *jitter, void *_data)
{
int i, ii;
@ -2194,6 +2362,7 @@ int scheme_do_generate_common(mz_jit_state *jitter, void *_data)
if (!common2(jitter, _data)) return 0;
if (!common3(jitter, _data)) return 0;
if (!common4(jitter, _data)) return 0;
if (!common4b(jitter, _data)) return 0;
if (!common5(jitter, _data)) return 0;
if (!common6(jitter, _data)) return 0;
if (!common7(jitter, _data)) return 0;

57
src/racket/src/jitinline.c
View File

@ -58,11 +58,21 @@ static int check_val_struct_prim(Scheme_Object *p, int arity)
return 1;
else if (((Scheme_Primitive_Proc *)p)->pp.flags & SCHEME_PRIM_IS_STRUCT_INDEXED_GETTER)
return 2;
else if (((Scheme_Primitive_Proc *)p)->pp.flags & SCHEME_PRIM_IS_STRUCT_OTHER) {
int t = (((Scheme_Primitive_Proc *)p)->pp.flags & SCHEME_PRIM_OTHER_TYPE_MASK);
if (t == SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER)
return 4;
else if (t == SCHEME_PRIM_TYPE_STRUCT_PROP_PRED)
return 6;
}
} else if (arity == 2) {
if ((((Scheme_Primitive_Proc *)p)->pp.flags & SCHEME_PRIM_IS_STRUCT_OTHER)
&& ((((Scheme_Primitive_Proc *)p)->pp.flags & SCHEME_PRIM_OTHER_TYPE_MASK)
== SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER))
return 3;
if ((((Scheme_Primitive_Proc *)p)->pp.flags & SCHEME_PRIM_IS_STRUCT_OTHER)) {
int t = (((Scheme_Primitive_Proc *)p)->pp.flags & SCHEME_PRIM_OTHER_TYPE_MASK);
if (t == SCHEME_PRIM_STRUCT_TYPE_INDEXED_SETTER)
return 3;
else if (t == SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER)
return 5;
}
}
}
return 0;
@ -326,12 +336,32 @@ static int generate_inlined_struct_op(int kind, mz_jit_state *jitter,
} else {
(void)jit_calli(sjc.struct_get_code);
}
} else {
} else if (kind == 3) {
if (multi_ok) {
(void)jit_calli(sjc.struct_set_multi_code);
} else {
(void)jit_calli(sjc.struct_set_code);
}
} else if (kind == 4) {
if (multi_ok) {
(void)jit_calli(sjc.struct_prop_get_multi_code);
} else {
(void)jit_calli(sjc.struct_prop_get_code);
}
} else if (kind == 5) {
if (multi_ok) {
(void)jit_calli(sjc.struct_prop_get_defl_multi_code);
} else {
(void)jit_calli(sjc.struct_prop_get_defl_code);
}
} else if (kind == 6) {
if (multi_ok) {
(void)jit_calli(sjc.struct_prop_pred_multi_code);
} else {
(void)jit_calli(sjc.struct_prop_pred_code);
}
} else {
scheme_signal_error("internal error: unknown struct-op mode");
}
return 1;
@ -353,8 +383,8 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
generate_inlined_struct_op(1, jitter, rator, app->rand, NULL, for_branch, branch_short, multi_ok);
scheme_direct_call_count++;
return 1;
} else if ((k == 2) && !for_branch) {
generate_inlined_struct_op(2, jitter, rator, app->rand, NULL, for_branch, branch_short, multi_ok);
} else if (((k == 2) || (k == 4) || (k == 6)) && !for_branch) {
generate_inlined_struct_op(k, jitter, rator, app->rand, NULL, for_branch, branch_short, multi_ok);
scheme_direct_call_count++;
return 1;
}
@ -1595,11 +1625,14 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
{
Scheme_Object *rator = app->rator;
if (!for_branch
&& inlineable_struct_prim(rator, jitter, 2, 2)) {
generate_inlined_struct_op(3, jitter, rator, app->rand1, app->rand2, for_branch, branch_short, multi_ok);
scheme_direct_call_count++;
return 1;
if (!for_branch) {
int k;
k = inlineable_struct_prim(rator, jitter, 2, 2);
if (k) {
generate_inlined_struct_op(k, jitter, rator, app->rand1, app->rand2, for_branch, branch_short, multi_ok);
scheme_direct_call_count++;
return 1;
}
}

13
src/racket/src/struct.c
View File

@ -1092,6 +1092,8 @@ static Scheme_Object *make_struct_type_property_from_c(int argc, Scheme_Object *
name[len+1] = 0;
v = scheme_make_folding_prim_closure(prop_pred, 1, a, name, 1, 1, 0);
((Scheme_Closed_Primitive_Proc *)v)->pp.flags |= (SCHEME_PRIM_IS_STRUCT_OTHER
| SCHEME_PRIM_TYPE_STRUCT_PROP_PRED);
*predout = v;
name = MALLOC_N_ATOMIC(char, len + 10);
@ -1099,7 +1101,8 @@ static Scheme_Object *make_struct_type_property_from_c(int argc, Scheme_Object *
memcpy(name + len, "-accessor", 10);
v = scheme_make_folding_prim_closure(prop_accessor, 1, a, name, 1, 2, 0);
((Scheme_Closed_Primitive_Proc *)v)->pp.flags |= SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER;
((Scheme_Closed_Primitive_Proc *)v)->pp.flags |= (SCHEME_PRIM_IS_STRUCT_OTHER
| SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER);
*accessout = v;
@ -2979,8 +2982,8 @@ struct_prop_getter_p(int argc, Scheme_Object *argv[])
Scheme_Object *v = argv[0];
if (SCHEME_CHAPERONEP(v)) v = SCHEME_CHAPERONE_VAL(v);
return ((STRUCT_mPROCP(v,
SCHEME_PRIM_OTHER_TYPE_MASK,
SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER)
SCHEME_PRIM_IS_STRUCT_OTHER | SCHEME_PRIM_OTHER_TYPE_MASK,
SCHEME_PRIM_IS_STRUCT_OTHER | SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER)
&& SAME_TYPE(SCHEME_TYPE(SCHEME_PRIM_CLOSURE_ELS(v)[0]), scheme_struct_property_type))
? scheme_true : scheme_false);
}
@ -2991,8 +2994,8 @@ chaperone_prop_getter_p(int argc, Scheme_Object *argv[])
Scheme_Object *v = argv[0];
if (SCHEME_CHAPERONEP(v)) v = SCHEME_CHAPERONE_VAL(v);
return ((STRUCT_mPROCP(v,
SCHEME_PRIM_OTHER_TYPE_MASK,
SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER)
SCHEME_PRIM_IS_STRUCT_OTHER | SCHEME_PRIM_OTHER_TYPE_MASK,
SCHEME_PRIM_IS_STRUCT_OTHER | SCHEME_PRIM_TYPE_STRUCT_PROP_GETTER)
&& SAME_TYPE(SCHEME_TYPE(SCHEME_PRIM_CLOSURE_ELS(v)[0]), scheme_chaperone_property_type))
? scheme_true : scheme_false);
}