jit tweaks

svn: r12144

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=?

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.}
 
    }}
 

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)

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++) {

src/mzscheme/src/mzmark.c

@@ -5299,9 +5299,11 @@ static int native_unclosed_proc_MARK(void *p) {
   int i;
 
   gcMARK(d->u2.name);
-  for (i = d->retain_count; 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,9 +5317,11 @@ static int native_unclosed_proc_FIXUP(void *p) {
   int i;
 
   gcFIXUP(d->u2.name);
-  for (i = d->retain_count; 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);
   }

src/mzscheme/src/mzmarksrc.c

@@ -2165,9 +2165,11 @@ native_unclosed_proc {
   int i;
 
   gcMARK(d->u2.name);
-  for (i = d->retain_count; 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);
   }

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);
 

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)
 {