diff --git a/collects/tests/mzscheme/port.ss b/collects/tests/mzscheme/port.ss index 7a66f1ec9b..8356754c50 100644 --- a/collects/tests/mzscheme/port.ss +++ b/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) diff --git a/src/mzscheme/src/port.c b/src/mzscheme/src/port.c index 8072390c98..310d83ef96 100644 --- a/src/mzscheme/src/port.c +++ b/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, diff --git a/src/mzscheme/src/print.c b/src/mzscheme/src/print.c index 3c509a8e81..94215479be 100644 --- a/src/mzscheme/src/print.c +++ b/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 * diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index 0e64241577..86f0060c08 100644 --- a/src/mzscheme/src/stxobj.c +++ b/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);