cs: provide hint to GC about places
The collector tries to use roughly the same amount of parallelism as the number of active threads, but make sure that it doesn't fall back to an ownership-mangling non-parallel collection if all but one place happens to be stalled.
This commit is contained in:
Matthew Flatt
parent
449f01b55d
commit
5c45588573
|
|
@ -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
|
||||
|
|
|
|||
12
Makefile
12
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)"
|
||||
|
|
|
|||
|
|
@ -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]))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -470,6 +470,7 @@ typedef struct thread_gc {
|
|||
|
||||
int during_alloc;
|
||||
IBOOL queued_fire;
|
||||
IBOOL preserve_ownership;
|
||||
|
||||
struct thread_gc *next;
|
||||
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
||||
%----------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))])
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user