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

JIT-inline check-not-undefined

Browse Source
This commit is contained in:
Matthew Flatt 2014-04-03 16:33:45 -06:00
parent 113a2eea21
commit 714ac04b55
9 changed files with 101 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
View File

@ -6,6 +6,7 @@
(require racket/flonum
racket/extflonum
racket/fixnum
racket/undefined
racket/unsafe/ops
compiler/zo-parse
compiler/zo-marshal)
@ -18,6 +19,7 @@
(namespace-require 'racket/flonum)
(namespace-require 'racket/extflonum)
(namespace-require 'racket/fixnum)
(namespace-require 'racket/undefined)
(eval '(define-values (prop:thing thing? thing-ref)
(make-struct-type-property 'thing)))
(eval '(struct rock (x) #:property prop:thing 'yes))
@ -99,11 +101,11 @@
(test v name ((eval `(lambda (y) (let ([x1 (fx+ (random 1) ',arg1)])
(,op x1 y))))
arg2)))))]
[bin-exact (lambda (v op arg1 arg2 [check-fixnum-as-bad? #f])
(check-error-message op (eval `(lambda (x) (,op x ',arg2))))
(check-error-message op (eval `(lambda (x) (,op ',arg1 x))))
(check-error-message op (eval `(lambda (x y) (,op x y))) #:first-arg arg1)
(check-error-message op (eval `(lambda (x y) (,op x y))) #:second-arg arg2)
[bin-exact (lambda (v op arg1 arg2 [check-fixnum-as-bad? #f] #:bad-value [bad-value 'bad])
(check-error-message op (eval `(lambda (x) (,op x ',arg2))) #:bad-value bad-value)
(check-error-message op (eval `(lambda (x) (,op ',arg1 x))) #:bad-value bad-value)
(check-error-message op (eval `(lambda (x y) (,op x y))) #:first-arg arg1 #:bad-value bad-value)
(check-error-message op (eval `(lambda (x y) (,op x y))) #:second-arg arg2 #:bad-value bad-value)
(when check-fixnum-as-bad?
(check-error-message op (eval `(lambda (x) (,op x ',arg2))) #t)
(check-error-message op (eval `(lambda (x) (,op x 10))) #t)
@ -790,6 +792,8 @@
(bin-exact 1.1t0 'extflvector-ref (extflvector 1.1t0 2.2t0 3.3t0) 0 #t)
(bin-exact 3.3t0 'extflvector-ref (extflvector 1.1t0 2.2t0 3.3t0) 2)
(un-exact 3 'extflvector-length (extflvector 1.1t0 2.2t0 3.3t0) #t)
(bin-exact 5 'check-not-undefined 5 'check-not-undefined #:bad-value undefined)
)
(let ([test-setter

15
racket/src/racket/src/fun.c
View File

@ -86,7 +86,7 @@ READ_ONLY Scheme_Object *scheme_values_func; /* the function bound to `values' *
READ_ONLY Scheme_Object *scheme_procedure_p_proc;
READ_ONLY Scheme_Object *scheme_procedure_arity_includes_proc;
READ_ONLY Scheme_Object *scheme_void_proc;
READ_ONLY Scheme_Object *scheme_check_not_undefined;
READ_ONLY Scheme_Object *scheme_check_not_undefined_proc;
READ_ONLY Scheme_Object *scheme_apply_proc;
READ_ONLY Scheme_Object *scheme_call_with_values_proc; /* the function bound to `call-with-values' */
READ_ONLY Scheme_Object *scheme_reduced_procedure_struct;
@ -161,7 +161,6 @@ static Scheme_Object *extract_one_cc_mark (int argc, Scheme_Object *argv[]);
static Scheme_Object *call_with_immediate_cc_mark (int argc, Scheme_Object *argv[]);
static Scheme_Object *void_func (int argc, Scheme_Object *argv[]);
static Scheme_Object *void_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *check_not_undefined (int argc, Scheme_Object *argv[]);
static Scheme_Object *dynamic_wind (int argc, Scheme_Object *argv[]);
#ifdef TIME_SYNTAX
static Scheme_Object *time_apply(int argc, Scheme_Object *argv[]);
@ -494,9 +493,11 @@ scheme_init_fun (Scheme_Env *env)
/* adds the new primitive check-undefined to the kernel langauge
check-undefined has an arity of 1 and no flags */
REGISTER_SO(scheme_check_not_undefined);
scheme_check_not_undefined = scheme_make_prim_w_arity(check_not_undefined, "check-not-undefined", 2, 2);
scheme_add_global_constant("check-not-undefined", scheme_check_not_undefined, env);
REGISTER_SO(scheme_check_not_undefined_proc);
o = scheme_make_prim_w_arity(scheme_check_not_undefined, "check-not-undefined", 2, 2);
scheme_check_not_undefined_proc = o;
SCHEME_PRIM_PROC_FLAGS(o) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("check-not-undefined", o, env);
scheme_add_global_constant("undefined", scheme_undefined, env);
@ -2533,8 +2534,8 @@ void_p (int argc, Scheme_Object *argv[])
return SAME_OBJ(argv[0], scheme_void) ? scheme_true : scheme_false;
}
static Scheme_Object *
check_not_undefined (int argc, Scheme_Object *argv[])
Scheme_Object *
scheme_check_not_undefined (int argc, Scheme_Object *argv[])
{
if (!SCHEME_SYMBOLP(argv[1]))
scheme_wrong_contract("check-not-undefined", "symbol?", 1, argc, argv);

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

@ -367,6 +367,7 @@ struct scheme_jit_common_record {
# endif
#endif
void *make_rest_list_code, *make_rest_list_clear_code;
void *call_check_not_defined_code;
Continuation_Apply_Indirect continuation_apply_indirect_code;
#ifdef MZ_USE_LWC

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

@ -106,6 +106,7 @@ define_ts_iS_s(scheme_checked_integer_to_char, FSRC_MARKS)
# ifndef CAN_INLINE_ALLOC
define_ts_iSi_s(scheme_build_list_offset, FSRC_OTHER)
# endif
define_ts_iS_s(scheme_check_not_undefined, FSRC_MARKS)
#endif
#ifdef JITCALL_TS_PROCS
@ -238,4 +239,5 @@ 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_check_not_undefined scheme_check_not_undefined
#endif

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

@ -3225,6 +3225,42 @@ static int common11(mz_jit_state *jitter, void *_data)
return 1;
}
static int common12(mz_jit_state *jitter, void *_data)
{
/* call_check_not_defined_code */
/* ares are in R0 and R1 */
{
GC_CAN_IGNORE jit_insn *refr USED_ONLY_FOR_FUTURES;
sjc.call_check_not_defined_code = jit_get_ip();
mz_prolog(JIT_R2);
jit_subi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(2));
JIT_UPDATE_THREAD_RSPTR();
jit_stxi_p(WORDS_TO_BYTES(1), JIT_RUNSTACK, JIT_R1);
jit_str_p(JIT_RUNSTACK, JIT_R0);
CHECK_LIMIT();
jit_movi_i(JIT_R0, 2);
mz_prepare(2);
jit_pusharg_p(JIT_RUNSTACK);
jit_pusharg_i(JIT_R0);
mz_finish_prim_lwe(ts_scheme_check_not_undefined, refr);
jit_addi_p(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(2));
JIT_UPDATE_THREAD_RSPTR();
mz_epilog(JIT_R2);
scheme_jit_register_sub_func(jitter, sjc.call_check_not_defined_code, scheme_false);
CHECK_LIMIT();
}
return 1;
}
int scheme_do_generate_common(mz_jit_state *jitter, void *_data)
{
if (!common0(jitter, _data)) return 0;
@ -3243,6 +3279,7 @@ int scheme_do_generate_common(mz_jit_state *jitter, void *_data)
if (!common9(jitter, _data)) return 0;
if (!common10(jitter, _data)) return 0;
if (!common11(jitter, _data)) return 0;
if (!common12(jitter, _data)) return 0;
return 1;
}

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

@ -3526,6 +3526,45 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
(void)jit_calli(sjc.proc_arity_includes_code);
jit_movr_p(dest, JIT_R0);
return 1;
} else if (IS_NAMED_PRIM(rator, "check-not-undefined")) {
if (SCHEME_SYMBOLP(app->rand2)) {
GC_CAN_IGNORE jit_insn *ref, *ref2;
LOG_IT(("inlined check-not-undefined\n"));
mz_runstack_skipped(jitter, 2);
scheme_generate_non_tail(app->rand1, jitter, 0, 1, 0); /* no sync... */
mz_runstack_unskipped(jitter, 2);
CHECK_LIMIT();
mz_rs_sync_fail_branch();
__START_TINY_JUMPS__(1);
ref = jit_bmsi_ul(jit_forward(), JIT_R0, 0x1);
ref2 = mz_bnei_t(jit_forward(), JIT_R0, scheme_undefined_type, JIT_R2);
__END_TINY_JUMPS__(1);
scheme_mz_load_retained(jitter, JIT_R1, app->rand2);
(void)jit_calli(sjc.call_check_not_defined_code);
/* never returns */
__START_TINY_JUMPS__(1);
mz_patch_branch(ref);
mz_patch_branch(ref2);
__END_TINY_JUMPS__(1);
CHECK_LIMIT();
} else {
scheme_generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
CHECK_LIMIT();
mz_rs_sync();
(void)jit_calli(sjc.call_check_not_defined_code);
}
jit_movr_p(dest, JIT_R0);
return 1;
} else if (IS_NAMED_PRIM(rator, "values")) {
Scheme_Object *args[3];

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

@ -737,7 +737,7 @@ Scheme_Object *letrec_check_local(Scheme_Object *o, Letrec_Check_Frame *frame,
app3 = MALLOC_ONE_TAGGED(Scheme_App3_Rec);
app3->iso.so.type = scheme_application3_type;
app3->rator = scheme_check_not_undefined;
app3->rator = scheme_check_not_undefined_proc;
app3->rand1 = o;
app3->rand2 = name;

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

@ -2577,7 +2577,7 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
app = (Scheme_App3_Rec *)o;
if (SAME_OBJ(app->rator, scheme_check_not_undefined)
if (SAME_OBJ(app->rator, scheme_check_not_undefined_proc)
&& SCHEME_SYMBOLP(app->rand2)) {
scheme_log(info->logger,
SCHEME_LOG_WARNING,

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

@ -435,7 +435,7 @@ extern Scheme_Object *scheme_values_func;
extern Scheme_Object *scheme_procedure_p_proc;
extern Scheme_Object *scheme_procedure_arity_includes_proc;
extern Scheme_Object *scheme_void_proc;
extern Scheme_Object *scheme_check_not_undefined;
extern Scheme_Object *scheme_check_not_undefined_proc;
extern Scheme_Object *scheme_pair_p_proc;
extern Scheme_Object *scheme_mpair_p_proc;
extern Scheme_Object *scheme_unsafe_cons_list_proc;
@ -3987,6 +3987,8 @@ 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_check_not_undefined (int argc, Scheme_Object *argv[]);
Scheme_Object *scheme_chaperone_vector_copy(Scheme_Object *obj);
Scheme_Object *scheme_chaperone_hash_table_copy(Scheme_Object *obj);