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

fix equal? for futures

Browse Source 
Closes PR 15331

Consider merge to v6.6
This commit is contained in:
Matthew Flatt 2016-07-20 09:27:41 +02:00
parent e2dd92c9c1
commit 7318b1fd34
4 changed files with 25 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/racket-test/tests/future/future.rkt
View File

@ -255,7 +255,7 @@ We should also test deep continuations.
(with-continuation-mark
x (+ 1000 x)
(nt-loop (sub1 x))))))))))
;; ----------------------------------------
(check-equal? 2
@ -345,6 +345,13 @@ We should also test deep continuations.
(touch f1))))]
[f3 (func (λ () (< (touch f2) 1)))])
(touch f3)))
(check-equal?
'((#f) (#t) (#f))
(map
touch
(for/list ([s (in-list '("a" "b" "c"))])
(future (λ () (list (equal? s "b")))))))
(check-equal?
'((1) (1))

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

@ -138,7 +138,7 @@ define_ts_ss_s(scheme_jit_make_two_element_vector, FSRC_OTHER)
define_ts_l_s(scheme_jit_make_ivector, FSRC_OTHER)
define_ts_l_s(scheme_jit_make_vector, FSRC_OTHER)
# endif
define_ts_ss_i(scheme_equal, FSRC_MARKS)
define_ts_ss_s(equal_as_bool, FSRC_MARKS)
define_ts_sss_s(extract_one_cc_mark_to_tag, FSRC_MARKS)
#endif
@ -219,7 +219,7 @@ define_ts_s_s(scheme_box, FSRC_OTHER)
# define ts_scheme_byte_string_length scheme_byte_string_length
# define ts_scheme_struct_ref scheme_struct_ref
# define ts_scheme_struct_set scheme_struct_set
# define ts_scheme_equal scheme_equal
# define ts_equal_as_bool equal_as_bool
# define ts_scheme_string_eq_2 scheme_string_eq_2
# define ts_scheme_byte_string_eq_2 scheme_byte_string_eq_2
# define ts_extract_one_cc_mark_to_tag extract_one_cc_mark_to_tag

3
racket/src/racket/src/jit_ts_future_glue.c
View File

@ -639,11 +639,14 @@
future->source_type = src_type;
future->arg_s0 = g282;
future->arg_s1 = g283;
printf("go _ss_i...\n");
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
future = fts->thread->current_ft;
retval = future->retval_i;
printf("!retval %d\n", retval);
future->retval_i = 0;
return retval;

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

@ -28,6 +28,7 @@
#include "jit.h"
static Scheme_Object *extract_one_cc_mark_to_tag(Scheme_Object *, Scheme_Object *, Scheme_Object *);
static Scheme_Object *equal_as_bool(Scheme_Object *a, Scheme_Object *b);
#define JITINLINE_TS_PROCS
#ifndef CAN_INLINE_ALLOC
@ -35,6 +36,14 @@ static Scheme_Object *extract_one_cc_mark_to_tag(Scheme_Object *, Scheme_Object
#endif
#include "jit_ts.c"
static Scheme_Object *equal_as_bool(Scheme_Object *a, Scheme_Object *b)
{
if (scheme_equal(a, b))
return scheme_true;
else
return scheme_false;
}
#ifdef MZ_USE_FUTURES
static Scheme_Object *ts_scheme_make_fsemaphore(int argc, Scheme_Object **argv)
XFORM_SKIP_PROC
@ -2723,7 +2732,7 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
return 1;
} else if (IS_NAMED_PRIM(rator, "equal?")) {
GC_CAN_IGNORE jit_insn *ref_f, *ref_d;
GC_CAN_IGNORE jit_insn *ref_f;
GC_CAN_IGNORE jit_insn *refr USED_ONLY_FOR_FUTURES;
scheme_generate_two_args(app->rand1, app->rand2, jitter, 0, 2);
@ -2735,7 +2744,7 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
jit_prepare(2);
jit_pusharg_p(JIT_R0);
jit_pusharg_p(JIT_R1);
mz_finish_prim_lwe(ts_scheme_equal, refr);
mz_finish_prim_lwe(ts_equal_as_bool, refr);
jit_retval(dest);
CHECK_LIMIT();
@ -2746,19 +2755,10 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
CHECK_LIMIT();
}
ref_f = jit_beqi_i(jit_forward(), JIT_R0, 0);
if (for_branch) {
ref_f = jit_beqi_p(jit_forward(), dest, scheme_false);
scheme_add_branch_false(for_branch, ref_f);
scheme_branch_for_true(jitter, for_branch);
} else {
(void)jit_movi_p(dest, scheme_true);
ref_d = jit_jmpi(jit_forward());
mz_patch_branch(ref_f);
(void)jit_movi_p(dest, scheme_false);
mz_patch_ucbranch(ref_d);
}
__END_SHORT_JUMPS__(branch_short);