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

JIT-inline symbol-interned?

Browse Source
This commit is contained in:
Matthew Flatt 2018-03-20 16:41:05 -06:00
parent 811ae4f72a
commit 808bdb6d0b
6 changed files with 74 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -344,6 +344,7 @@ struct scheme_jit_common_record {
void *bad_char_to_integer_code, *slow_integer_to_char_code;
void *slow_cpointer_tag_code, *slow_set_cpointer_tag_code;
void *values_code;
void *symbol_interned_p_code;
void *list_p_code, *list_p_branch_code;
void *list_length_code;
void *list_ref_code, *list_tail_code;

2
racket/src/racket/src/jit_ts.c
View File

@ -116,6 +116,7 @@ define_ts__v(chaperone_set_mark, FSRC_MARKS)
define_ts_ss_s(scheme_chaperone_get_immediate_cc_mark, FSRC_MARKS)
define_ts_iS_s(scheme_checked_char_to_integer, FSRC_MARKS)
define_ts_iS_s(scheme_checked_integer_to_char, FSRC_MARKS)
define_ts_iS_s(scheme_checked_symbol_interned_p, FSRC_MARKS)
# ifndef CAN_INLINE_ALLOC
define_ts_iSi_s(scheme_build_list_offset, FSRC_OTHER)
# endif
@ -272,6 +273,7 @@ define_ts_s_s(scheme_box, FSRC_OTHER)
# define ts_scheme_struct_setter scheme_struct_setter
# define ts_scheme_checked_char_to_integer scheme_checked_char_to_integer
# define ts_scheme_checked_integer_to_char scheme_checked_integer_to_char
# define ts_scheme_checked_symbol_interned_p scheme_checked_symbol_interned_p
# define ts_scheme_check_not_undefined scheme_check_not_undefined
# define ts_scheme_check_assign_not_undefined scheme_check_assign_not_undefined
# define ts_scheme_foreign_ptr_ref scheme_foreign_ptr_ref

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

@ -3446,6 +3446,29 @@ static int common11(mz_jit_state *jitter, void *_data)
CHECK_LIMIT();
}
/* symbol_interned_p_code */
/* R0 has non-symbol argument */
{
GC_CAN_IGNORE jit_insn *refr USED_ONLY_FOR_FUTURES;
sjc.symbol_interned_p_code = jit_get_ip();
mz_prolog(JIT_R2);
jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(1));
JIT_UPDATE_THREAD_RSPTR();
jit_str_p(JIT_RUNSTACK, JIT_R0);
CHECK_LIMIT();
jit_movi_i(JIT_R0, 1);
mz_prepare(2);
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_i(JIT_R0);
mz_finish_prim_lwe(ts_scheme_checked_symbol_interned_p, refr); /* doesn't return */
scheme_jit_register_sub_func(jitter, sjc.symbol_interned_p_code, scheme_false);
CHECK_LIMIT();
}
return 1;
}

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

@ -1423,6 +1423,47 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
return 1;
} else if (IS_NAMED_PRIM(rator, "char-whitespace?")) {
generate_inlined_char_category_test(jitter, app, SCHEME_ISSPACE_BIT, for_branch, branch_short, dest);
return 1;
} else if (IS_NAMED_PRIM(rator, "symbol-interned?")) {
GC_CAN_IGNORE jit_insn *ref1, *reffail, *ref_no;
mz_runstack_skipped(jitter, 1);
scheme_generate_non_tail(app->rand, jitter, 0, 1, 0);
CHECK_LIMIT();
mz_runstack_unskipped(jitter, 1);
mz_rs_sync();
__START_SHORT_JUMPS__(branch_short);
__START_INNER_TINY__(branch_short);
ref1 = jit_bmci_ul(jit_forward(), JIT_R0, 0x1);
__END_INNER_TINY__(branch_short);
reffail = jit_get_ip();
(void)jit_calli(sjc.symbol_interned_p_code);
__START_INNER_TINY__(branch_short);
mz_patch_branch(ref1);
(void)mz_bnei_t(reffail, JIT_R0, scheme_symbol_type, JIT_R2);
__END_INNER_TINY__(branch_short);
jit_ldxi_s(JIT_R2, JIT_R0, &MZ_OPT_HASH_KEY(&((Scheme_Symbol *)0x0)->iso));
if (for_branch) {
ref_no = jit_bmsi_ul(jit_forward(), JIT_R2, 0x3);
scheme_add_branch_false(for_branch, ref_no);
scheme_branch_for_true(jitter, for_branch);
} else {
(void)jit_movi_p(dest, scheme_false);
__START_INNER_TINY__(branch_short);
ref_no = jit_bmsi_ul(jit_forward(), JIT_R2, 0x3);
(void)jit_movi_p(dest, scheme_true);
mz_patch_branch(ref_no);
__END_INNER_TINY__(branch_short);
}
__END_SHORT_JUMPS__(branch_short);
return 1;
} else if (IS_NAMED_PRIM(rator, "list?")
|| IS_NAMED_PRIM(rator, "list-pair?")) {

1
racket/src/racket/src/schpriv.h
View File

@ -3732,6 +3732,7 @@ Scheme_Object *scheme_checked_make_flrectangular (int argc, Scheme_Object *argv[
Scheme_Object *scheme_procedure_arity_includes(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_checked_char_to_integer(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_checked_integer_to_char(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_checked_symbol_interned_p(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_checked_make_vector(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_checked_hash_ref(int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_checked_hash_count(int argc, Scheme_Object *argv[]);

11
racket/src/racket/src/symbol.c
View File

@ -72,7 +72,6 @@ READ_ONLY Scheme_Object *scheme_keyword_p_proc;
static Scheme_Object *symbol_lt (int argc, Scheme_Object *argv[]);
static Scheme_Object *symbol_p_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *symbol_unreadable_p_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *symbol_interned_p_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *string_to_symbol_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *string_to_uninterned_symbol_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *string_to_unreadable_symbol_prim (int argc, Scheme_Object *argv[]);
@ -343,8 +342,10 @@ scheme_init_symbol (Scheme_Startup_Env *env)
p = scheme_make_folding_prim(symbol_unreadable_p_prim, "symbol-unreadable?", 1, 1, 1);
scheme_addto_prim_instance("symbol-unreadable?", p, env);
p = scheme_make_folding_prim(symbol_interned_p_prim, "symbol-interned?", 1, 1, 1);
p = scheme_make_folding_prim(scheme_checked_symbol_interned_p, "symbol-interned?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_PRODUCES_BOOL);
scheme_addto_prim_instance("symbol-interned?", p, env);
ADD_FOLDING_PRIM("symbol<?", symbol_lt, 2, -1, 1, env);
@ -778,8 +779,8 @@ symbol_p_prim (int argc, Scheme_Object *argv[])
return SCHEME_SYMBOLP(argv[0]) ? scheme_true : scheme_false;
}
static Scheme_Object *
symbol_interned_p_prim (int argc, Scheme_Object *argv[])
Scheme_Object *
scheme_checked_symbol_interned_p (int argc, Scheme_Object *argv[])
{
if (SCHEME_SYMBOLP(argv[0]))
return (SCHEME_SYM_WEIRDP(argv[0]) ? scheme_false : scheme_true);