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

some unsafe-...* fixes on chaperones

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-04 20:18:36 -06:00
parent 649242ac86
commit 5a7ef5ee3f
3 changed files with 35 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/tests/racket/unsafe.rktl
View File

@ -231,6 +231,9 @@
#:pre (lambda () (set-box! b 12))
#:post (lambda (x) (list x (unbox b)))
#:literal-ok? #f)))
(test-un 3 'unsafe-unbox* (chaperone-box (box 3)
(lambda (b v) v)
(lambda (b v) v)))
(for ([star (list values (add-star "vector"))])
(test-bin 5 (star 'unsafe-vector-ref) #(1 5 7) 1)
@ -240,6 +243,13 @@
#:pre (lambda () (vector-set! v 2 0))
#:post (lambda (x) (list x (vector-ref v 2)))
#:literal-ok? #f)))
(test-bin 5 'unsafe-vector*-ref (chaperone-vector #(1 5 7)
(lambda (v i x) x)
(lambda (v i x) x))
1)
(test-un 3 'unsafe-vector*-length (chaperone-vector #(1 5 7)
(lambda (v i x) x)
(lambda (v i x) x)))
(test-bin 53 'unsafe-bytes-ref #"157" 1)
(test-un 3 'unsafe-bytes-length #"157")

5
src/racket/src/jit.c
View File

@ -6751,8 +6751,10 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
(void)jit_calli(bad_flvector_length_code);
else if (for_fx)
(void)jit_calli(bad_fxvector_length_code);
else
else {
(void)jit_calli(bad_vector_length_code);
jit_retval(JIT_R0);
}
/* bad_vector_length_code may unpack a proxied object */
__START_TINY_JUMPS__(1);
@ -6870,6 +6872,7 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
ref = jit_bnei_i(jit_forward(), JIT_R1, scheme_chaperone_type);
(void)jit_calli(unbox_code);
ref2 = jit_jmpi(jit_forward());
jit_retval(JIT_R0);
mz_patch_branch(ref);
CHECK_LIMIT();
__END_TINY_JUMPS__(1);

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

@ -154,7 +154,9 @@ static Scheme_Object *unsafe_mcdr (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_set_mcar (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_set_mcdr (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_unbox (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_set_box (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_set_box_star (int argc, Scheme_Object *argv[]);
static Scheme_Object *chaperone_hash_key(const char *name, Scheme_Object *table, Scheme_Object *key);
static Scheme_Object *chaperone_hash_tree_set(Scheme_Object *table, Scheme_Object *key, Scheme_Object *val);
@ -781,7 +783,7 @@ scheme_init_unsafe_list (Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("unsafe-unbox", p, env);
p = scheme_make_immed_prim(unsafe_unbox, "unsafe-unbox*", 1, 1);
p = scheme_make_immed_prim(unsafe_unbox_star, "unsafe-unbox*", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("unsafe-unbox*", p, env);
@ -789,7 +791,7 @@ scheme_init_unsafe_list (Scheme_Env *env)
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_add_global_constant("unsafe-set-box!", p, env);
p = scheme_make_immed_prim(unsafe_set_box, "unsafe-set-box*!", 2, 2);
p = scheme_make_immed_prim(unsafe_set_box_star, "unsafe-set-box*!", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_add_global_constant("unsafe-set-box*!", p, env);
}
@ -3434,8 +3436,25 @@ static Scheme_Object *unsafe_unbox (int argc, Scheme_Object *argv[])
return SCHEME_BOX_VAL(argv[0]);
}
static Scheme_Object *unsafe_unbox_star (int argc, Scheme_Object *argv[])
{
if (SCHEME_NP_CHAPERONEP(argv[0]))
return chaperone_unbox(argv[0]);
else
return SCHEME_BOX_VAL(argv[0]);
}
static Scheme_Object *unsafe_set_box (int argc, Scheme_Object *argv[])
{
SCHEME_BOX_VAL(argv[0]) = argv[1];
return scheme_void;
}
static Scheme_Object *unsafe_set_box_star (int argc, Scheme_Object *argv[])
{
if (SCHEME_NP_CHAPERONEP(argv[0]))
chaperone_set_box(argv[0], argv[1]);
else
SCHEME_BOX_VAL(argv[0]) = argv[1];
return scheme_void;
}