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

inline flvector-length

Browse Source 
svn: r17178
This commit is contained in:
Matthew Flatt 2009-12-03 18:04:02 +00:00
parent 4eef1b3cee
commit c73b587e98
5 changed files with 64 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/tests/mzscheme/unsafe.ss
View File

@ -187,18 +187,13 @@
#:post (lambda (x) (list x (string-ref v 2)))
#:literal-ok? #f))
(let ([flvector (lambda args
(let ([v (make-flvector (length args))])
(for ([a args]
[i (in-naturals)])
(flvector-set! v i a))
v))])
(test-bin 9.5 'unsafe-flvector-ref (flvector 1.0 9.5 18.7) 1)
(let ([v (flvector 1.0 9.5 18.7)])
(test-tri (list (void) 27.4) 'unsafe-flvector-set! v 2 27.4
#:pre (lambda () (flvector-set! v 2 0.0))
#:post (lambda (x) (list x (flvector-ref v 2)))
#:literal-ok? #f)))
(test-bin 9.5 'unsafe-flvector-ref (flvector 1.0 9.5 18.7) 1)
(test-un 5 'unsafe-flvector-length (flvector 1.1 2.0 3.1 4.5 5.7))
(let ([v (flvector 1.0 9.5 18.7)])
(test-tri (list (void) 27.4) 'unsafe-flvector-set! v 2 27.4
#:pre (lambda () (flvector-set! v 2 0.0))
#:post (lambda (x) (list x (flvector-ref v 2)))
#:literal-ok? #f))
(test-bin 9.5 'unsafe-f64vector-ref (f64vector 1.0 9.5 18.7) 1)
(let ([v (f64vector 1.0 9.5 18.7)])

43
src/mzscheme/src/jit.c
View File

@ -143,6 +143,7 @@ static void *bad_mcar_code, *bad_mcdr_code;
static void *bad_set_mcar_code, *bad_set_mcdr_code;
static void *bad_unbox_code;
static void *bad_vector_length_code;
static void *bad_flvector_length_code;
static void *vector_ref_code, *vector_ref_check_index_code, *vector_set_code, *vector_set_check_index_code;
static void *string_ref_code, *string_ref_check_index_code, *string_set_code, *string_set_check_index_code;
static void *bytes_ref_code, *bytes_ref_check_index_code, *bytes_set_code, *bytes_set_check_index_code;
@ -5516,8 +5517,21 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
return 1;
} else if (IS_NAMED_PRIM(rator, "vector-length")
|| IS_NAMED_PRIM(rator, "unsafe-vector-length")) {
|| IS_NAMED_PRIM(rator, "unsafe-vector-length")
|| IS_NAMED_PRIM(rator, "flvector-length")
|| IS_NAMED_PRIM(rator, "unsafe-flvector-length")) {
GC_CAN_IGNORE jit_insn *reffail, *ref;
int unsafe = 0, for_fl = 0;
if (IS_NAMED_PRIM(rator, "unsafe-vector-length")) {
unsafe = 1;
} else if (IS_NAMED_PRIM(rator, "flvector-length")) {
for_fl = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-flvector-length")) {
unsafe = 1;
for_fl = 1;
}
LOG_IT(("inlined vector-length\n"));
@ -5528,7 +5542,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
mz_runstack_unskipped(jitter, 1);
if (!IS_NAMED_PRIM(rator, "unsafe-vector-length")) {
if (!unsafe) {
mz_rs_sync_fail_branch();
__START_TINY_JUMPS__(1);
@ -5536,16 +5550,25 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
__END_TINY_JUMPS__(1);
reffail = _jit.x.pc;
(void)jit_calli(bad_vector_length_code);
if (!for_fl)
(void)jit_calli(bad_vector_length_code);
else
(void)jit_calli(bad_flvector_length_code);
__START_TINY_JUMPS__(1);
mz_patch_branch(ref);
jit_ldxi_s(JIT_R1, JIT_R0, &((Scheme_Object *)0x0)->type);
(void)jit_bnei_i(reffail, JIT_R1, scheme_vector_type);
if (!for_fl)
(void)jit_bnei_i(reffail, JIT_R1, scheme_vector_type);
else
(void)jit_bnei_i(reffail, JIT_R1, scheme_flvector_type);
__END_TINY_JUMPS__(1);
}
(void)jit_ldxi_i(JIT_R0, JIT_R0, &SCHEME_VEC_SIZE(0x0));
if (!for_fl)
(void)jit_ldxi_i(JIT_R0, JIT_R0, &SCHEME_VEC_SIZE(0x0));
else
(void)jit_ldxi_l(JIT_R0, JIT_R0, &SCHEME_FLVEC_SIZE(0x0));
jit_lshi_l(JIT_R0, JIT_R0, 1);
jit_ori_l(JIT_R0, JIT_R0, 0x1);
@ -8735,6 +8758,16 @@ static int do_generate_common(mz_jit_state *jitter, void *_data)
CHECK_LIMIT();
register_sub_func(jitter, bad_vector_length_code, scheme_false);
/* *** bad_flvector_length_code *** */
/* R0 is argument */
bad_flvector_length_code = jit_get_ip().ptr;
mz_prolog(JIT_R1);
jit_prepare(1);
jit_pusharg_i(JIT_R0);
(void)mz_finish(ts_scheme_flvector_length);
CHECK_LIMIT();
register_sub_func(jitter, bad_flvector_length_code, scheme_false);
/* *** call_original_unary_arith_code *** */
/* R0 is arg, R2 is code pointer, V1 is return address */
for (i = 0; i < 3; i++) {

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

@ -60,6 +60,7 @@ define_ts_iS_s(scheme_checked_set_mcar, FSRC_OTHER)
define_ts_iS_s(scheme_checked_set_mcdr, FSRC_OTHER)
define_ts_s_s(scheme_unbox, FSRC_OTHER)
define_ts_s_s(scheme_vector_length, FSRC_OTHER)
define_ts_s_s(scheme_flvector_length, FSRC_OTHER)
define_ts_s_s(tail_call_with_values_from_multiple_result, FSRC_OTHER)
define_ts_s_v(raise_bad_call_with_values, FSRC_OTHER)
define_ts_s_s(call_with_values_from_multiple_result_multi, FSRC_OTHER)
@ -122,6 +123,7 @@ define_ts_siS_v(wrong_argument_count, FSRC_OTHER)
# define ts_scheme_checked_set_mcdr scheme_checked_set_mcdr
# define ts_scheme_unbox scheme_unbox
# define ts_scheme_vector_length scheme_vector_length
# define ts_scheme_flvector_length scheme_flvector_length
# define ts_tail_call_with_values_from_multiple_result tail_call_with_values_from_multiple_result
# define ts_raise_bad_call_with_values raise_bad_call_with_values
# define ts_call_with_values_from_multiple_result_multi call_with_values_from_multiple_result_multi

27
src/mzscheme/src/number.c
View File

@ -100,8 +100,8 @@ static Scheme_Object *int_sqrt_rem (int argc, Scheme_Object *argv[]);
static Scheme_Object *flvector (int argc, Scheme_Object *argv[]);
static Scheme_Object *flvector_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *make_flvector (int argc, Scheme_Object *argv[]);
static Scheme_Object *flvector_length (int argc, Scheme_Object *argv[]);
static Scheme_Object *make_flvector (int argc, Scheme_Object *argv[]);
static Scheme_Object *fx_and (int argc, Scheme_Object *argv[]);
static Scheme_Object *fx_or (int argc, Scheme_Object *argv[]);
@ -521,11 +521,11 @@ scheme_init_number (Scheme_Env *env)
"make-flvector",
1, 2),
env);
scheme_add_global_constant("flvector-length",
scheme_make_immed_prim(flvector_length,
"flvector-length",
1, 1),
env);
p = scheme_make_immed_prim(flvector_length, "flvector-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("flvector-length", p, env);
p = scheme_make_immed_prim(scheme_checked_flvector_ref,
"flvector-ref",
2, 2);
@ -587,7 +587,7 @@ void scheme_init_unsafe_number(Scheme_Env *env)
p = scheme_make_immed_prim(unsafe_flvector_length, "unsafe-flvector-length",
1, 1);
/* SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED; */
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("unsafe-flvector-length", p, env);
p = scheme_make_immed_prim(unsafe_flvector_ref, "unsafe-flvector-ref",
@ -2929,12 +2929,17 @@ static Scheme_Object *make_flvector (int argc, Scheme_Object *argv[])
return (Scheme_Object *)vec;
}
Scheme_Object *scheme_flvector_length(Scheme_Object *vec)
{
if (!SCHEME_FLVECTORP(vec))
scheme_wrong_type("flvector-length", "flvector", 0, 1, &vec);
return scheme_make_integer(SCHEME_FLVEC_SIZE(vec));
}
static Scheme_Object *flvector_length (int argc, Scheme_Object *argv[])
{
if (!SCHEME_FLVECTORP(argv[0]))
scheme_wrong_type("flvector-length", "flvector", 0, argc, argv);
return scheme_make_integer(SCHEME_FLVEC_SIZE(argv[0]));
return scheme_flvector_length(argv[0]);
}
Scheme_Object *scheme_checked_flvector_ref (int argc, Scheme_Object *argv[])

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

@ -3194,6 +3194,7 @@ Scheme_Object *scheme_checked_syntax_e(int argc, Scheme_Object **argv);
Scheme_Object *scheme_vector_length(Scheme_Object *v);
Scheme_Object *scheme_checked_flvector_ref(int argc, Scheme_Object **argv);
Scheme_Object *scheme_checked_flvector_set(int argc, Scheme_Object **argv);
Scheme_Object *scheme_flvector_length(Scheme_Object *v);
void scheme_bad_vec_index(char *name, Scheme_Object *i,
const char *what, Scheme_Object *vec,