From 00d2aabaf06b0fd75eee91f5abd06ebaef9175b2 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 27 Oct 2008 19:00:13 +0000 Subject: [PATCH] jit tweaks svn: r12144 --- collects/compiler/decompile.ss | 2 +- .../scribblings/reference/subprocess.scrbl | 6 ++- collects/tests/mzscheme/optimize.ss | 3 ++ src/mzscheme/src/jit.c | 48 ++++++++++++++++++- src/mzscheme/src/mzmark.c | 12 +++-- src/mzscheme/src/mzmarksrc.c | 6 ++- src/mzscheme/src/schpriv.h | 2 +- src/mzscheme/src/vector.c | 16 +++++-- 8 files changed, 79 insertions(+), 16 deletions(-) diff --git a/collects/compiler/decompile.ss b/collects/compiler/decompile.ss index 5f1248b43e..12075f4119 100644 --- a/collects/compiler/decompile.ss +++ b/collects/compiler/decompile.ss @@ -299,7 +299,7 @@ zero? negative? exact-nonnegative-integer? exact-positive-integer? car cdr caar cadr cdar cddr - mcar mcdr unbox syntax-e + mcar mcdr unbox vector-length syntax-e add1 sub1 - abs bitwise-not))] [(3) (memq (car a) '(eq? = <= < >= > bitwise-bit-set? char=? diff --git a/collects/scribblings/reference/subprocess.scrbl b/collects/scribblings/reference/subprocess.scrbl index 98d49cfef2..ff4ce18a2d 100644 --- a/collects/scribblings/reference/subprocess.scrbl +++ b/collects/scribblings/reference/subprocess.scrbl @@ -301,7 +301,11 @@ Executes a shell command asynchronously. The result is a list of five values: under @|AllUnix|, and takes no action under Windows. The result is @|void-const|.} - @item{@scheme['kill] terminates the subprocess and returns @|void-const|.} + @item{@scheme['kill] terminates the subprocess and returns + @|void-const|. Note that the immediate process created by + @scheme[process] is a shell process that may run another program; + terminating the shell process may not terminate processes that + the shell starts, particularly under Windows.} }} diff --git a/collects/tests/mzscheme/optimize.ss b/collects/tests/mzscheme/optimize.ss index 0ca2ffbd6b..7c6bf28997 100644 --- a/collects/tests/mzscheme/optimize.ss +++ b/collects/tests/mzscheme/optimize.ss @@ -329,6 +329,9 @@ (bin-exact 'b 'vector-ref #(a b c) 1) (bin-exact 'c 'vector-ref #(a b c) 2) + (un-exact 'a 'unbox (box 'a)) + (un-exact 3 'vector-length (vector 'a 'b 'c)) + (bin-exact #\a 'string-ref "abc\u2001" 0) (bin-exact #\b 'string-ref "abc\u2001" 1) (bin-exact #\c 'string-ref "abc\u2001" 2) diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 002049abba..eab698aad5 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -125,6 +125,7 @@ static void *bad_caar_code, *bad_cdar_code, *bad_cadr_code, *bad_cddr_code; 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 *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; @@ -445,8 +446,7 @@ static void *generate_one(mz_jit_state *old_jitter, #ifdef MZ_PRECISE_GC if (ndata) { memset(jitter->retain_start, 0, num_retained * sizeof(void*)); - ndata->retained = jitter->retain_start; - ndata->retain_count = num_retained; + ndata->retained = (num_retained ? jitter->retain_start : NULL); SCHEME_BOX_VAL(fnl_obj) = scheme_make_integer(size_pre_retained); GC_set_finalizer(fnl_obj, 1, 3, release_native_code, buffer, @@ -465,6 +465,11 @@ static void *generate_one(mz_jit_state *old_jitter, jitter->self_toplevel_pos = -1; jitter->status_at_ptr = NULL; + /* Leave room for retained size on first pass, + install it if needed) on second pass:*/ + if (!known_size || num_retained) + mz_retain_it(jitter, (void *)scheme_make_integer(num_retained)); + ok = generate(jitter, data); if (save_ptr) { @@ -503,6 +508,7 @@ static void *generate_one(mz_jit_state *old_jitter, known_size += (JIT_WORD_SIZE - (known_size & (JIT_WORD_SIZE - 1))); } num_retained = jitter->retained; + if (num_retained == 1) num_retained = 0; /* Keep this buffer? Don't if it's too big, or if it's a part of old_jitter, or if there's already a bigger cache. */ @@ -3869,6 +3875,36 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in CHECK_LIMIT(); __END_TINY_JUMPS__(1); + return 1; + } else if (IS_NAMED_PRIM(rator, "vector-length")) { + GC_CAN_IGNORE jit_insn *reffail, *ref; + + LOG_IT(("inlined vector-length\n")); + + mz_runstack_skipped(jitter, 1); + + generate_non_tail(app->rand, jitter, 0, 1); + CHECK_LIMIT(); + + mz_runstack_unskipped(jitter, 1); + + __START_TINY_JUMPS__(1); + ref = jit_bmci_ul(jit_forward(), JIT_R0, 0x1); + __END_TINY_JUMPS__(1); + + reffail = _jit.x.pc; + (void)jit_jmpi(bad_vector_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); + __END_TINY_JUMPS__(1); + + (void)jit_ldxi_i(JIT_R0, JIT_R0, &SCHEME_VEC_SIZE(0x0)); + jit_lshi_l(JIT_R0, JIT_R0, 1); + jit_ori_l(JIT_R0, JIT_R0, 0x1); + return 1; } else if (IS_NAMED_PRIM(rator, "unbox")) { GC_CAN_IGNORE jit_insn *reffail, *ref; @@ -6181,6 +6217,14 @@ static int do_generate_common(mz_jit_state *jitter, void *_data) (void)mz_finish(scheme_unbox); CHECK_LIMIT(); + /* *** bad_vector_length_code *** */ + /* R0 is argument */ + bad_vector_length_code = jit_get_ip().ptr; + jit_prepare(1); + jit_pusharg_i(JIT_R0); + (void)mz_finish(scheme_vector_length); + CHECK_LIMIT(); + /* *** call_original_unary_arith_code *** */ /* R0 is arg, R2 is code pointer, V1 is return address */ for (i = 0; i < 3; i++) { diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index 41b09f93d2..db9cd15931 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -5299,8 +5299,10 @@ static int native_unclosed_proc_MARK(void *p) { int i; gcMARK(d->u2.name); - for (i = d->retain_count; i--; ) { - gcMARK(d->retained[i]); + if (d->retained) { + for (i = SCHEME_INT_VAL(d->retained[0]); i--; ) { + gcMARK(d->retained[i]); + } } if (d->closure_size < 0) { gcMARK(d->u.arities); @@ -5315,8 +5317,10 @@ static int native_unclosed_proc_FIXUP(void *p) { int i; gcFIXUP(d->u2.name); - for (i = d->retain_count; i--; ) { - gcFIXUP(d->retained[i]); + if (d->retained) { + for (i = SCHEME_INT_VAL(d->retained[0]); i--; ) { + gcFIXUP(d->retained[i]); + } } if (d->closure_size < 0) { gcFIXUP(d->u.arities); diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index 8530a366e0..08b79a41aa 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -2165,8 +2165,10 @@ native_unclosed_proc { int i; gcMARK(d->u2.name); - for (i = d->retain_count; i--; ) { - gcMARK(d->retained[i]); + if (d->retained) { + for (i = SCHEME_INT_VAL(d->retained[0]); i--; ) { + gcMARK(d->retained[i]); + } } if (d->closure_size < 0) { gcMARK(d->u.arities); diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 0ab5091ff3..0447a44fe6 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -1970,7 +1970,6 @@ typedef struct Scheme_Native_Closure_Data { } u2; #ifdef MZ_PRECISE_GC void **retained; /* inside code */ - mzshort retain_count; #endif } Scheme_Native_Closure_Data; @@ -3049,6 +3048,7 @@ Scheme_Object *scheme_checked_string_set(int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_byte_string_ref(int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_byte_string_set(int argc, Scheme_Object *argv[]); Scheme_Object *scheme_checked_syntax_e(int argc, Scheme_Object **argv); +Scheme_Object *scheme_vector_length(Scheme_Object *v); Scheme_Bucket_Table *scheme_make_weak_equal_table(void); diff --git a/src/mzscheme/src/vector.c b/src/mzscheme/src/vector.c index 84251858e8..b88279e30f 100644 --- a/src/mzscheme/src/vector.c +++ b/src/mzscheme/src/vector.c @@ -62,11 +62,10 @@ scheme_init_vector (Scheme_Env *env) "vector-immutable", 0, -1), env); - scheme_add_global_constant("vector-length", - scheme_make_folding_prim(vector_length, - "vector-length", - 1, 1, 1), - env); + + p = scheme_make_folding_prim(vector_length, "vector-length", 1, 1, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED; + scheme_add_global_constant("vector-length", p, env); p = scheme_make_immed_prim(scheme_checked_vector_ref, "vector-ref", @@ -210,6 +209,13 @@ vector_length (int argc, Scheme_Object *argv[]) return scheme_make_integer(SCHEME_VEC_SIZE(argv[0])); } +Scheme_Object *scheme_vector_length(Scheme_Object *v) +{ + Scheme_Object *a[1]; + a[0] = v; + return vector_length(1, a); +} + static Scheme_Object * bad_index(char *name, Scheme_Object *i, Scheme_Object *vec, int bottom) {