diff --git a/.makefile b/.makefile index 269b972925..c4a944ee3e 100644 --- a/.makefile +++ b/.makefile @@ -338,7 +338,7 @@ RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) # This branch name changes each time the pb boot files are updated: -PB_BRANCH == circa-7.9.0.2-2 +PB_BRANCH == circa-7.9.0.2-3 PB_REPO = https://github.com/racket/pb # Alternative source for Chez Scheme boot files, normally set by diff --git a/Makefile b/Makefile index 3db5178ad9..ed6b30b347 100644 --- a/Makefile +++ b/Makefile @@ -47,7 +47,7 @@ RACKETCS_SUFFIX = RACKET = RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) -PB_BRANCH = circa-7.9.0.2-2 +PB_BRANCH = circa-7.9.0.2-3 PB_REPO = https://github.com/racket/pb EXTRA_REPOS_BASE = CS_CROSS_SUFFIX = @@ -306,14 +306,14 @@ maybe-fetch-pb-as-is: echo done fetch-pb-from: mkdir -p racket/src/ChezScheme/boot - if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-7.9.0.2-2 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.2-2:remotes/origin/circa-7.9.0.2-2 ; fi - cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.2-2 + if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-7.9.0.2-3 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.2-3:remotes/origin/circa-7.9.0.2-3 ; fi + cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.2-3 pb-stage: - cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.2-2 - cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.2-2 + cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.2-3 + cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.2-3 cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build" pb-push: - cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.2-2 + cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.2-3 win-cs-base: IF "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-bc-then-cs-base SETUP_BOOT_MODE=--boot WIN32_BUILD_LEVEL=bc PLAIN_RACKET=racket\racketbc DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETBC_SUFFIX="$(RACKETBC_SUFFIX)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" IF not "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-just-cs-base SETUP_BOOT_MODE=--chain DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" RACKET_FOR_BUILD="$(RACKET_FOR_BUILD)" diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 43b11a9fdf..f8f439d018 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.9.0.2") +(define version "7.9.0.3") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/ChezScheme/c/gcwrapper.c b/racket/src/ChezScheme/c/gcwrapper.c index 5591620594..767ff8d8da 100644 --- a/racket/src/ChezScheme/c/gcwrapper.c +++ b/racket/src/ChezScheme/c/gcwrapper.c @@ -1286,7 +1286,10 @@ ptr S_gc(ptr tc, IGEN max_cg, IGEN min_tg, IGEN max_tg, ptr count_roots) { if (S_G.enable_object_backreferences) min_tg = max_tg; return S_gc_oce(tc, max_cg, min_tg, max_tg, count_roots); #if defined(PTHREADS) - } else if (S_collect_waiting_threads != 0) { + } else if ((S_collect_waiting_threads != 0) + || (Spairp(S_threads) + && Spairp(Scdr(S_threads)) + && (S_num_preserve_ownership_threads > 0))) { return S_gc_par(tc, max_cg, min_tg, max_tg, Sfalse); #endif } else if (max_cg == 0 && min_tg == 1 && max_tg == 1 diff --git a/racket/src/ChezScheme/c/globals.h b/racket/src/ChezScheme/c/globals.h index ecdf11697f..ed5e52977b 100644 --- a/racket/src/ChezScheme/c/globals.h +++ b/racket/src/ChezScheme/c/globals.h @@ -40,8 +40,10 @@ EXTERN scheme_mutex_t S_tc_mutex; EXTERN s_thread_cond_t S_collect_cond; EXTERN s_thread_cond_t S_collect_thread0_cond; EXTERN scheme_mutex_t S_alloc_mutex; /* ordered after S_tc_mutex */ +EXTERN s_thread_cond_t S_terminated_cond; EXTERN int S_collect_waiting_threads; EXTERN ptr S_collect_waiting_tcs[maximum_parallel_collect_threads]; +EXTERN int S_num_preserve_ownership_threads; # ifdef IMPLICIT_ATOMIC_AS_EXPLICIT EXTERN s_thread_mutex_t S_implicit_mutex; # endif diff --git a/racket/src/ChezScheme/c/prim.c b/racket/src/ChezScheme/c/prim.c index e6ffca80d6..6c612a9e98 100644 --- a/racket/src/ChezScheme/c/prim.c +++ b/racket/src/ChezScheme/c/prim.c @@ -132,6 +132,7 @@ static void create_c_entry_vector() { S_install_c_entry(CENTRY_raw_collect_cond, TO_PTR(&S_collect_cond)); S_install_c_entry(CENTRY_raw_collect_thread0_cond, TO_PTR(&S_collect_thread0_cond)); S_install_c_entry(CENTRY_raw_tc_mutex, TO_PTR(&S_tc_mutex)); + S_install_c_entry(CENTRY_raw_terminated_cond, TO_PTR(&S_terminated_cond)); S_install_c_entry(CENTRY_activate_thread, proc2ptr(S_activate_thread)); S_install_c_entry(CENTRY_deactivate_thread, proc2ptr(Sdeactivate_thread)); S_install_c_entry(CENTRY_unactivate_thread, proc2ptr(S_unactivate_thread)); @@ -158,7 +159,7 @@ void S_check_c_entry_vector() { for (i = 0; i < c_entry_vector_size; i++) { #ifndef PTHREADS if (i == CENTRY_raw_collect_cond || i == CENTRY_raw_collect_thread0_cond - || i == CENTRY_raw_tc_mutex + || i == CENTRY_raw_tc_mutex || i == CENTRY_raw_terminated_cond || i == CENTRY_activate_thread || i == CENTRY_deactivate_thread || i == CENTRY_unactivate_thread) continue; diff --git a/racket/src/ChezScheme/c/prim5.c b/racket/src/ChezScheme/c/prim5.c index 40f8d7a778..335e69ac5f 100644 --- a/racket/src/ChezScheme/c/prim5.c +++ b/racket/src/ChezScheme/c/prim5.c @@ -99,6 +99,7 @@ static void s_mutex_acquire PROTO((scheme_mutex_t *m)); static ptr s_mutex_acquire_noblock PROTO((scheme_mutex_t *m)); static void s_condition_broadcast PROTO((s_thread_cond_t *c)); static void s_condition_signal PROTO((s_thread_cond_t *c)); +static void s_thread_preserve_ownership PROTO((ptr tc)); #endif static void s_byte_copy(ptr src, iptr srcoff, ptr dst, iptr dstoff, iptr cnt); static void s_ptr_copy(ptr src, iptr srcoff, ptr dst, iptr dstoff, iptr cnt); @@ -1522,6 +1523,15 @@ static void s_condition_broadcast(s_thread_cond_t *c) { static void s_condition_signal(s_thread_cond_t *c) { s_thread_cond_signal(c); } + +/* called with tc mutex held */ +static void s_thread_preserve_ownership(ptr tc) { + if (!THREAD_GC(tc)->preserve_ownership) { + THREAD_GC(tc)->preserve_ownership = 1; + S_num_preserve_ownership_threads++; + } +} + #endif static ptr s_profile_counters(void) { @@ -1601,6 +1611,7 @@ void S_prim5_init() { Sforeign_symbol("(cs)condition_broadcast", (void *)s_condition_broadcast); Sforeign_symbol("(cs)condition_signal", (void *)s_condition_signal); Sforeign_symbol("(cs)condition_wait", (void *)S_condition_wait); + Sforeign_symbol("(cs)thread_preserve_ownership", (void *)s_thread_preserve_ownership); #endif Sforeign_symbol("(cs)s_addr_in_heap", (void *)s_addr_in_heap); Sforeign_symbol("(cs)s_ptr_in_heap", (void *)s_ptr_in_heap); diff --git a/racket/src/ChezScheme/c/thread.c b/racket/src/ChezScheme/c/thread.c index 586e0ae93f..87d1fb40fa 100644 --- a/racket/src/ChezScheme/c/thread.c +++ b/racket/src/ChezScheme/c/thread.c @@ -37,6 +37,7 @@ void S_thread_init() { s_thread_cond_init(&S_collect_cond); s_thread_cond_init(&S_collect_thread0_cond); s_thread_mutex_init(&S_alloc_mutex.pmutex); + s_thread_cond_init(&S_terminated_cond); S_alloc_mutex.owner = 0; S_alloc_mutex.count = 0; @@ -167,7 +168,8 @@ ptr S_create_thread_object(who, p_tc) const char *who; ptr p_tc; { for (i = 0; i < (int)DIRTY_SEGMENT_LISTS; i++) tgc->dirty_segments[i] = NULL; tgc->thread = (ptr)0; - + tgc->preserve_ownership = 0; + tc_mutex_release(); return thread; @@ -289,6 +291,9 @@ static IBOOL destroy_thread(tc) ptr tc; { if (LZ4OUTBUFFER(tc) != (ptr)0) free(TO_VOIDP(LZ4OUTBUFFER(tc))); if (SIGNALINTERRUPTQUEUE(tc) != (ptr)0) free(TO_VOIDP(SIGNALINTERRUPTQUEUE(tc))); + if (THREAD_GC(tc)->preserve_ownership) + --S_num_preserve_ownership_threads; + /* Never free a thread_gc, since it may be recorded in a segment as the segment's creator. Recycle manually, instead. */ THREAD_GC(tc)->sweeper = main_sweeper_index; @@ -300,6 +305,8 @@ static IBOOL destroy_thread(tc) ptr tc; { THREADTC(thread) = 0; /* mark it dead */ status = 1; + + s_thread_cond_broadcast(&S_terminated_cond); break; } ls = &Scdr(*ls); diff --git a/racket/src/ChezScheme/c/types.h b/racket/src/ChezScheme/c/types.h index 4acf568f0a..235f16b0f0 100644 --- a/racket/src/ChezScheme/c/types.h +++ b/racket/src/ChezScheme/c/types.h @@ -470,6 +470,7 @@ typedef struct thread_gc { int during_alloc; IBOOL queued_fire; + IBOOL preserve_ownership; struct thread_gc *next; diff --git a/racket/src/ChezScheme/csug/threads.stex b/racket/src/ChezScheme/csug/threads.stex index c495006b7f..747d261574 100644 --- a/racket/src/ChezScheme/csug/threads.stex +++ b/racket/src/ChezScheme/csug/threads.stex @@ -89,15 +89,21 @@ synchronized across processors. \scheme{fork-thread} invokes \var{thunk} in a new thread and returns a thread object. -Nothing can be done with the thread object returned by -\scheme{fork-thread}, other than to print it or use it with inspection -functions such as \scheme{compute-size}. - Threads created by foreign code using some means other than \scheme{fork-thread} must call \scheme{Sactivate_thread} (Section~\ref{SECTFOREIGNCLIB}) before touching any Scheme data or calling any Scheme procedures. +%---------------------------------------------------------------------------- +\noskipentryheader +\formdef{thread-join}{\categoryprocedure}{(thread-join \var{thread})} +\returns unspecified +\listlibraries +\endnoskipentryheader + +\noindent +Waits until \var{thread} has commpleted. + %---------------------------------------------------------------------------- \entryheader \formdef{get-initial-thread}{\categoryprocedure}{(get-initial-thread)} @@ -126,6 +132,20 @@ relationship to the process id returned by \index{\scheme{get-process-id}}\scheme{get-process-id}, which is the same in all threads. +%---------------------------------------------------------------------------- +\noskipentryheader +\formdef{thread-preserve-ownership!}{\categoryprocedure}{(thread-preserve-ownership!)} +\formdef{thread-preserve-ownership!}{\categoryprocedure}{(thread-preserve-ownership! \var{thread})} +\returns unspecified +\listlibraries +\endnoskipentryheader + +\noindent +Provides a hint to the storage manager that \var{thread} (which +defaults to the current thread if not supplied) can particularly +benefit from tracking the objects that it allocates for parallel +collection. + \section{Mutexes} %---------------------------------------------------------------------------- diff --git a/racket/src/ChezScheme/makefiles/Mf-install.in b/racket/src/ChezScheme/makefiles/Mf-install.in index 2fbaf09aa4..2b0a799cfe 100644 --- a/racket/src/ChezScheme/makefiles/Mf-install.in +++ b/racket/src/ChezScheme/makefiles/Mf-install.in @@ -62,7 +62,7 @@ InstallLZ4Target= # no changes should be needed below this point # ############################################################################### -Version=csv9.5.3.40 +Version=csv9.5.3.41 Include=boot/$m PetiteBoot=boot/$m/petite.boot SchemeBoot=boot/$m/scheme.boot diff --git a/racket/src/ChezScheme/s/cmacros.ss b/racket/src/ChezScheme/s/cmacros.ss index ea2289980f..6a7972345c 100644 --- a/racket/src/ChezScheme/s/cmacros.ss +++ b/racket/src/ChezScheme/s/cmacros.ss @@ -357,7 +357,7 @@ ;; --------------------------------------------------------------------- ;; Version and machine types: -(define-constant scheme-version #x09050328) +(define-constant scheme-version #x09050329) (define-syntax define-machine-types (lambda (x) @@ -2942,6 +2942,7 @@ raw-collect-cond raw-collect-thread0-cond raw-tc-mutex + raw-terminated-cond activate-thread deactivate-thread unactivate-thread diff --git a/racket/src/ChezScheme/s/cpnanopass.ss b/racket/src/ChezScheme/s/cpnanopass.ss index 27c0c34626..478b1a23f0 100644 --- a/racket/src/ChezScheme/s/cpnanopass.ss +++ b/racket/src/ChezScheme/s/cpnanopass.ss @@ -6553,6 +6553,8 @@ (when-feature pthreads (define-inline 2 $raw-tc-mutex [() `(literal ,(make-info-literal #f 'entry (lookup-c-entry raw-tc-mutex) 0))]) + (define-inline 2 $raw-terminated-cond + [() `(literal ,(make-info-literal #f 'entry (lookup-c-entry raw-terminated-cond) 0))]) (define-inline 2 $raw-collect-cond [() `(literal ,(make-info-literal #f 'entry (lookup-c-entry raw-collect-cond) 0))]) (define-inline 2 $raw-collect-thread0-cond diff --git a/racket/src/ChezScheme/s/primdata.ss b/racket/src/ChezScheme/s/primdata.ss index a1dec8f61d..da69d8394d 100644 --- a/racket/src/ChezScheme/s/primdata.ss +++ b/racket/src/ChezScheme/s/primdata.ss @@ -1765,6 +1765,8 @@ (textual-port-output-size [sig [(textual-output-port) -> (length)]] [flags discard]) (thread? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (thread-condition? [feature pthreads] [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) + (thread-join [feature pthreads] [sig [(ptr) -> (void)]] [flags true]) + (thread-preserve-ownership! [feature pthreads] [sig [() -> (void)] [(ptr) -> (void)]] [flags true]) (top-level-bound? [sig [(symbol) (symbol environment) -> (boolean)]] [flags discard]) (top-level-mutable? [sig [(symbol) (symbol environment) -> (boolean)]] [flags discard]) (top-level-syntax [sig [(symbol) (symbol environment) -> (ptr)]] [flags discard]) @@ -2275,6 +2277,7 @@ ($raw-collect-cond [feature pthreads] [flags single-valued]) ($raw-collect-thread0-cond [feature pthreads] [flags single-valued]) ($raw-tc-mutex [feature pthreads] [flags single-valued]) + ($raw-terminated-cond [feature pthreads] [flags single-valued]) ($read-performance-monitoring-counter [flags single-valued]) ($read-time-stamp-counter [flags single-valued]) ($real->flonum [flags single-valued arith-op mifoldable discard]) @@ -2450,6 +2453,7 @@ ($session-key [flags]) ($symbol-ht-rtd [flags]) ($tc-mutex [feature pthreads] [flags]) + ($terminated-cond [feature pthreads] [flags]) ) (define-symbol-flags* ([libraries] [flags system-keyword]) ; condition types diff --git a/racket/src/ChezScheme/s/prims.ss b/racket/src/ChezScheme/s/prims.ss index 22909f79fb..f92ba6b249 100644 --- a/racket/src/ChezScheme/s/prims.ss +++ b/racket/src/ChezScheme/s/prims.ss @@ -1760,7 +1760,10 @@ (define $raw-collect-cond (lambda () ($raw-collect-cond))) (define $raw-collect-thread0-cond (lambda () ($raw-collect-thread0-cond))) (define $raw-tc-mutex (lambda () ($raw-tc-mutex))) +(define $raw-terminated-cond (lambda () ($raw-terminated-cond))) (define fork-thread) +(define thread-join) +(define thread-preserve-ownership!) (define make-mutex) (define mutex?) (define mutex-name) @@ -1776,6 +1779,7 @@ (define $tc-mutex) (define $collect-cond) (define $collect-thread0-cond) +(define $terminated-cond) (define get-initial-thread) (let () ; scheme-object's below are mutex and condition addresses, which are @@ -1837,6 +1841,29 @@ (t) (void)))))))) +(set-who! thread-join + (lambda (t) + (unless (thread? t) + ($oops who "~a is not a thread" t)) + (with-tc-mutex + (let f () + (unless (eq? ($thread-tc t) 0) + (condition-wait $terminated-cond $tc-mutex) + (f)))))) + +(set-who! thread-preserve-ownership! + (let ([preserve! (foreign-procedure "(cs)thread_preserve_ownership" (ptr) void)]) + (case-lambda + [(t) + (unless (thread? t) + ($oops who "~a is not a thread" t)) + (with-tc-mutex + (let ([tc ($thread-tc t)]) + (unless (eq? tc 0) + (preserve! tc))))] + [() + (with-tc-mutex (preserve! ($tc)))]))) + (set-who! make-mutex (case-lambda [() (make-mutex-no-check #f)] @@ -1953,6 +1980,7 @@ (set! $tc-mutex ($make-mutex ($raw-tc-mutex) '$tc-mutex)) (set! $collect-cond ($make-condition ($raw-collect-cond) '$collect-cond)) (set! $collect-thread0-cond ($make-condition ($raw-collect-thread0-cond) '$collect-thread0-cond)) +(set! $terminated-cond ($make-condition ($raw-terminated-cond) '$terminated-cond)) (set! get-initial-thread (let ([thread (car (ts))]) diff --git a/racket/src/cs/rumble/place.ss b/racket/src/cs/rumble/place.ss index bf8a9d1dad..9d5b9191bd 100644 --- a/racket/src/cs/rumble/place.ss +++ b/racket/src/cs/rumble/place.ss @@ -82,6 +82,7 @@ (do-prepare-for-place) (fork-thread (lambda () (collect-trip-for-allocating-places! +1) + (thread-preserve-ownership!) ; encourages parallel GC (init-virtual-registers) (place-registers (vector-copy place-register-inits)) (root-thread-cell-values (make-empty-thread-cell-values)) diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index ed88288e3f..1f255fa123 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 9 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 2 +#define MZSCHEME_VERSION_W 3 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x