fix bug in port-commit-peeked

svn: r1324

collects/tests/mzscheme/port.ss

@@ -550,5 +550,30 @@
     (test-values '(#f #f #f) (lambda () (port-next-location none)))))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Check that if the initial commit thread is killed, then
+;;  another commit thread is broken, that the second doesn't
+;;  assume that the initial commit thread is still there:
+
+(let ()
+  (define-values (r w) (make-pipe))
+  (define ch (make-channel))
+  (display "hi" w)
+  (peek-byte r)
+  (let ([t (thread (lambda ()
+		     (port-commit-peeked 1 (port-progress-evt r) ch r)))])
+    (sleep 0.01)
+    (let ([t2
+	   (thread (lambda ()
+		     (port-commit-peeked 1 (port-progress-evt r) ch r)))])
+      (sleep 0.01)
+      (thread-suspend t2)
+      (break-thread t2)
+      (kill-thread t)
+      (thread-resume t2)
+      (sleep)))
+  (test (char->integer #\h) peek-byte r))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 
 (report-errs)

src/mzscheme/src/port.c

@@ -1790,8 +1790,9 @@ static void remove_extra(void *ip_v)
     }
   }
 
-  /* Tell the main commit thread to reset */
-  scheme_post_sema_all(ip->input_giveup);
+  /* Tell the main commit thread (if any) to reset */
+  if (ip->input_giveup)
+    scheme_post_sema_all(ip->input_giveup);
 }
 
 static int complete_peeked_read_via_get(Scheme_Input_Port *ip,

src/mzscheme/src/print.c

@@ -129,6 +129,7 @@ static Scheme_Hash_Table *global_constants_ht;
 # define ZERO_SIZED(closure) closure->zero_sized
 #endif
 
+static Scheme_Hash_Table *cache_ht;
 
 void scheme_init_print(Scheme_Env *env)
 {
@@ -151,6 +152,8 @@ void scheme_init_print(Scheme_Env *env)
 #ifdef MZ_PRECISE_GC
   register_traversers();
 #endif
+
+  REGISTER_SO(cache_ht);
 }
 
 Scheme_Object *scheme_make_svector(mzshort c, mzshort *a)
@@ -694,18 +697,34 @@ static void setup_graph_table(Scheme_Object *obj, Scheme_Hash_Table *ht,
   }
 }
 
+#define CACHE_HT_SIZE_LIMIT 32
+
 Scheme_Hash_Table *scheme_setup_datum_graph(Scheme_Object *o, void *for_print)
 {
   Scheme_Hash_Table *ht;
   int counter = 1;
 
-  ht = scheme_make_hash_table(SCHEME_hash_ptr);
+  if (cache_ht) {
+    ht = cache_ht;
+    cache_ht = NULL;
+  } else
+    ht = scheme_make_hash_table(SCHEME_hash_ptr);
+
   setup_graph_table(o, ht, &counter, (PrintParams *)for_print);
 
   if (counter > 1)
     return ht;
-  else
+  else {
+    if (ht->size < CACHE_HT_SIZE_LIMIT) {
+      int i;
+      for (i = 0; i < ht->size; i++) {
+	ht->keys[i] = NULL;
+	ht->vals[i] = NULL;
+      }
+      cache_ht = ht;
+    }
     return NULL;
+  }
 }
 
 static char *

src/mzscheme/src/stxobj.c

@@ -2354,7 +2354,7 @@ static Scheme_Object *resolve_env(Scheme_Object *a, long phase,
       vec = SCHEME_PTR_VAL(WRAP_POS_FIRST(wraps));
       n = SCHEME_VEC_ELS(vec)[0];
       phase -= SCHEME_INT_VAL(n);
-      
+     
       src = SCHEME_VEC_ELS(vec)[1];
       dest = SCHEME_VEC_ELS(vec)[2];
 
@@ -2475,7 +2475,6 @@ static Scheme_Object *resolve_env(Scheme_Object *a, long phase,
       did_rib = NULL;
     }
 
-
     if (!rib)
       WRAP_POS_INC(wraps);
   }
@@ -2503,7 +2502,7 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, long phase)
 	result = SCHEME_STX_VAL(a);
 
       ((Scheme_Stx *)a)->u.modinfo_cache = result;
-      
+ 
       return result;
     } else if (SCHEME_RENAMESP(WRAP_POS_FIRST(wraps))) {
       Module_Renames *mrn = (Module_Renames *)WRAP_POS_FIRST(wraps);