suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

301.14: add current-thread-initial-stack-size, change make install to always run setup-plt, clean up debugging GC variants

Browse Source 
svn: r2878
This commit is contained in:
Matthew Flatt 2006-05-09 15:54:46 +00:00
parent 3f7a7d28c0
commit c97a02c0b4
21 changed files with 1515 additions and 1470 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
notes/mzscheme/HISTORY
View File

@ -1,3 +1,14 @@
Version 301.14
Added current-thread-initial-stack-size
Version 301.13
Dropped PLTHOME, and instead added support to embed a path to the
main "collects" directory within the executable
Changed bitwise-{and,ior,xor} to accept 0 arguments
Added 'run-file, 'collects-dir, and 'orig-dir modes to find-system-path
Changed initial program binding to the result of find-system path
with 'run-file instead of 'exec-file
Version 301.12
Added char-general-category
Changed readtable to support "default" parser used for symbols/numbers

23
src/Makefile.in
View File

@ -15,9 +15,12 @@ mred-stub: @MAKE_MRED@
mred3m-stub: @MAKE_MRED3M@
install:
plain-install:
$(MAKE) install-normal
$(MAKE) finish-stub
install:
$(MAKE) plain-install
$(MAKE) setup-plt
install-normal:
if [ ! -d $(prefix) ] ; then mkdir $(prefix) ; fi
@ -30,16 +33,17 @@ copytree-stub: @MAKE_COPYTREE@
mredinstall-stub: @MAKE_MREDINSTALL@
finish-stub: @MAKE_FINISH@
setup-plt:
$(prefix)/bin/mzscheme -mvqM setup
install-3m:
plain-install-3m:
$(MAKE) install-normal
$(MAKE) mzinstall3m
$(MAKE) mredinstall3m-stub
$(MAKE) finish-stub
install-3m:
$(MAKE) plain-install-3m
$(MAKE) setup-plt
mredinstall3m-stub: @MAKE_MREDINSTALL3M@
@ -81,13 +85,6 @@ lib-finish:
srcdir = @srcdir@
prefix = @prefix@
copy-finish:
$(MAKE) setup-plt
inplace-finish:
if [ ! -d $(srcdir)/../collects/repos-time-stamp ] ; then $(MAKE) setup-plt ; fi
if [ -d $(srcdir)/../collects/repos-time-stamp ] ; then cat $(srcdir)/mzscheme/imsg.txt ; fi
copytree:
cp -p -r $(srcdir)/../collects $(prefix)/.
cp -p -r $(srcdir)/../include $(prefix)/.

13
src/README
View File

@ -147,9 +147,10 @@ the Unix instructions below, but note the following:
the directory plt/bin/mzscheme. For a --prefix, build, the rest of
the plt tree is also copied to the target directory.
Excep for an in-place build from the Subversion archive (see step
4), this step also compiles ".zo" bytecode files for installed
Scheme source.
This step also compiles ".zo" bytecode files for installed Scheme
source, and generates launcher programs like "DrScheme". Use `make
plain-install' to install without compiling ".zo" files or
creating launchers.
If the installation fails because the target directory cannot be
created, or because the target directory is not the one you
@ -162,12 +163,6 @@ the Unix instructions below, but note the following:
--enabled-shared, beware that you may accumlate many old, unused
versions of the dynamic libraries in plt/lib.
4. ONLY Subversion users with in-place builds: the `make install'
step does not automatically build ".zo" files. After an initial
in-place install, run `make setup-plt'. For subsequent installs
within the same Subversion checkout, you can run either `make
setup-plt' or `plt/bin/setup-plt'.
After an "in-place" install without Subversion, the plt/src directory
is no longer needed, and it can be safely deleted. Build information
is recorded in plt/lib/buildinfo.

2
src/configure vendored
View File

@ -5058,7 +5058,6 @@ fi
if test "${prefix}" = "NONE" ; then
prefix=`cd "${srcdir}/.." && pwd`
MAKE_FINISH=inplace-finish
else
# Check whether ${prefix} is redundant, because
# $prefix/src is $srcdir.
@ -5075,7 +5074,6 @@ else
echo "----> ${prefix}/man/..."
echo "----> ${prefix}/notes/..."
MAKE_COPYTREE=copytree
MAKE_FINISH=copy-finish
fi
fi

2
src/mac/mzscheme/simpledrop.cpp
View File

@ -489,7 +489,7 @@ char *ExeRelativeToAbsolute(char *p)
CFURLRef url;
CFStringRef str;
char *s, *a;
long len, len2, len3;
long len, len2;
appBundle = CFBundleGetMainBundle();
url = CFBundleCopyExecutableURL(appBundle);

9
src/mred/mred.cxx
View File

@ -2856,14 +2856,17 @@ void wxTraceDone(void)
void wxObjectFinalize(void *o)
{
if (((wxObject *)o)->__type != -1) {
#if 0
/* Not every gc instance is a wxObject instance, now: */
if (((wxObject *)o)->__type != -1) {
# if 0
/* New non-cleanup flag makes this incorrect: */
fprintf(stderr, "ERROR: free wxObject had non-deleted type value!");
#else
# else
((wxObject *)o)->__type = -1;
#endif
# endif
}
#endif
}
static void set_trace_arg(Scheme_Object *a)

2
src/mred/wxs/wxscheme.cxx
View File

@ -705,7 +705,7 @@ static Scheme_Object *wxSchemeGetColourFromUser(int argc, Scheme_Object **argv)
}
cpInfo.dstProfile = NULL; // default Profile (again!)
cpInfo.flags = NULL;
cpInfo.flags = 0;
cpInfo.placeWhere = kCenterOnMainScreen;
cpInfo.dialogOrigin.h = 0;
cpInfo.dialogOrigin.v = 0;

2
src/mzscheme/configure.ac
View File

@ -123,7 +123,6 @@ fi
if test "${prefix}" = "NONE" ; then
prefix=`cd "${srcdir}/.." && pwd`
MAKE_FINISH=inplace-finish
else
# Check whether ${prefix} is redundant, because
# $prefix/src is $srcdir.
@ -140,7 +139,6 @@ else
echo "----> ${prefix}/man/..."
echo "----> ${prefix}/notes/..."
MAKE_COPYTREE=copytree
MAKE_FINISH=copy-finish
fi
fi

8
src/mzscheme/gc2/weak.c
View File

@ -55,16 +55,18 @@ static int mark_weak_array(void *p)
weak_arrays = a;
#if CHECKS
/* For now, weak arrays only used for symbols and falses: */
/* For now, weak arrays only used for symbols, keywords, and falses: */
{
void **data;
int i;
data = a->data;
for (i = a->count; i--; ) {
if (data[i]
&& (*(short *)(data[i]) != 46)
&& (*(short *)(data[i]) != 56))
&& (*(short *)(data[i]) != 47)
&& (*(short *)(data[i]) != 48)
&& (*(short *)(data[i]) != 57)) {
CRASH(1);
}
}
}
#endif

4
src/mzscheme/imsg.txt
View File

@ -1,4 +0,0 @@
-----------------------------------------------------------
>> `make setup-plt' or run `plt/bin/setup-plt' to finish <<
-----------------------------------------------------------

1
src/mzscheme/include/scheme.h
View File

@ -1124,6 +1124,7 @@ enum {
MZCONFIG_SCHEDULER_RANDOM_STATE,
MZCONFIG_THREAD_SET,
MZCONFIG_THREAD_INIT_STACK_SIZE,
__MZCONFIG_BUILTIN_COUNT__
};

14
src/mzscheme/sconfig.h
View File

@ -14,20 +14,6 @@
#ifndef FLAGS_ALREADY_SET
/*************** (BEGIN PLATFORM-INDEPENDENT OPTIONS) *************/
/*******************************/
/* Evaluator Tuning Parameters */
/*******************************/
#define SCHEME_STACK_SIZE 5000
/* SCHEME_STACK_SIZE <X> sets the size of stack segments for Scheme
variables. */
/**************** (END PLATFORM-INDEPENDENT OPTIONS) **************/
/******** (BEGIN KNOWN ARCHITECTURE/SYSTEM CONFIGURATIONS) ********/

32
src/mzscheme/sgc/sgc.c
View File

@ -3027,16 +3027,16 @@ static int trace_path_buffer_pos;
#endif
#if PAD_BOUNDARY_BYTES
static void bad_pad(char *where, void *s, long sz, long diff, long offset,
static void bad_pad(char *where, void *s, int type, long sz, long diff, long offset,
long pd, long expect)
{
FPRINTF(STDERR,
"pad %s violation at %lx, len %ld (diff %ld+%ld): %lx != %lx\n",
where, (unsigned long)s, sz, diff, offset, pd, expect);
"pad %s violation at %lx <%d>, len %ld (diff %ld+%ld): %lx != %lx\n",
where, (unsigned long)s, type, sz, diff, offset, pd, expect);
}
#endif
static void collect_init_chunk(MemoryChunk *c, int uncollectable)
static void collect_init_chunk(MemoryChunk *c, int uncollectable, int ty)
{
for (; c; c = c->next) {
if (uncollectable && TRACE_COLLECT_SWITCH)
@ -3053,20 +3053,20 @@ static void collect_init_chunk(MemoryChunk *c, int uncollectable)
diff = ((long *)s)[1];
pd = *(long *)s;
if (pd != PAD_PATTERN)
bad_pad("start", s, sz, diff, 0, pd, PAD_PATTERN);
bad_pad("start", s, ty, sz, diff, 0, pd, PAD_PATTERN);
pd = *(long *)INT_TO_PTR(c->end - PAD_END_SIZE);
if (pd != PAD_PATTERN)
bad_pad("end1", s, sz, diff, 0, pd, PAD_PATTERN);
bad_pad("end1", s, ty, sz, diff, 0, pd, PAD_PATTERN);
pd = *(long *)INT_TO_PTR(c->end - PAD_END_SIZE + sizeof(long));
if (pd != PAD_PATTERN)
bad_pad("end2", s, sz, diff, 0, pd, PAD_PATTERN);
bad_pad("end2", s, ty, sz, diff, 0, pd, PAD_PATTERN);
if (diff) {
/* Given was bigger than requested; check extra bytes: */
unsigned char *ps = ((unsigned char *)s) + sz - PAD_END_SIZE - diff;
long d = 0;
while (d < diff) {
if (*ps != PAD_FILL_PATTERN) {
bad_pad("extra", s, sz, diff, d, *ps, PAD_FILL_PATTERN);
bad_pad("extra", s, ty, sz, diff, d, *ps, PAD_FILL_PATTERN);
}
ps++;
d++;
@ -3132,7 +3132,7 @@ static void collect_finish_chunk(MemoryChunk **c, GC_Set *set)
high_plausible = local_high_plausible;
}
static void collect_init_common(BlockOfMemory **blocks, int uncollectable)
static void collect_init_common(BlockOfMemory **blocks, int uncollectable, int ty)
{
int i, j;
int boundary, boundary_val = 0;
@ -3164,20 +3164,20 @@ static void collect_init_common(BlockOfMemory **blocks, int uncollectable)
pd = *(long *)s;
diff = ((long *)s)[1];
if (pd != PAD_PATTERN)
bad_pad("start", s, size, diff, 0, pd, PAD_PATTERN);
bad_pad("start", s, ty, size, diff, 0, pd, PAD_PATTERN);
pd = *(long *)INT_TO_PTR(p + size - PAD_END_SIZE);
if (pd != PAD_PATTERN)
bad_pad("end1", s, size, diff, 0, pd, PAD_PATTERN);
bad_pad("end1", s, ty, size, diff, 0, pd, PAD_PATTERN);
pd = *(long *)INT_TO_PTR(p + size - PAD_END_SIZE + sizeof(long));
if (pd != PAD_PATTERN)
bad_pad("end2", s, size, diff, 0, pd, PAD_PATTERN);
bad_pad("end2", s, ty, size, diff, 0, pd, PAD_PATTERN);
if (diff) {
/* Given was bigger than requested; check extra bytes: */
unsigned char *ps = ((unsigned char *)s) + size - PAD_END_SIZE - diff;
long d = 0;
while (d < diff) {
if (*ps != PAD_FILL_PATTERN) {
bad_pad("extra", s, size, diff, d, *ps, PAD_FILL_PATTERN);
bad_pad("extra", s, ty, size, diff, d, *ps, PAD_FILL_PATTERN);
}
ps++;
d++;
@ -4312,9 +4312,11 @@ static void do_GC_gcollect(void *stack_now)
if (!common_sets[j]->locked) {
# endif
collect_init_chunk(*(common_sets[j]->othersptr),
common_sets[j]->uncollectable);
common_sets[j]->uncollectable,
j);
collect_init_common(common_sets[j]->blocks,
common_sets[j]->uncollectable);
common_sets[j]->uncollectable,
j);
# if ALLOW_SET_LOCKING
}
# endif

2758
src/mzscheme/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

22
src/mzscheme/src/eval.c
View File

@ -229,8 +229,6 @@ static Scheme_Object *scheme_compile_expand_expr(Scheme_Object *form, Scheme_Com
typedef void (*DW_PrePost_Proc)(void *);
#define TAIL_COPY_THRESHOLD 5
#if defined(UNIX_FIND_STACK_BOUNDS) || defined(WINDOWS_FIND_STACK_BOUNDS) \
|| defined(MACOS_FIND_STACK_BOUNDS) || defined(ASSUME_FIXED_STACK_SIZE) \
|| defined(BEOS_FIND_STACK_BOUNDS) || defined(OSKIT_FIXED_STACK_BOUNDS) \
@ -634,7 +632,7 @@ void scheme_init_stack_check()
int scheme_check_runstack(long size)
/* Checks whether the Scheme stack has `size' room left */
{
return ((MZ_RUNSTACK - MZ_RUNSTACK_START) >= (size + TAIL_COPY_THRESHOLD));
return ((MZ_RUNSTACK - MZ_RUNSTACK_START) >= (size + SCHEME_TAIL_COPY_THRESHOLD));
}
void *scheme_enlarge_runstack(long size, void *(*k)())
@ -644,6 +642,7 @@ void *scheme_enlarge_runstack(long size, void *(*k)())
Scheme_Saved_Stack *saved;
void *v;
int cont_count;
long min_size;
saved = MALLOC_ONE_RT(Scheme_Saved_Stack);
@ -655,9 +654,14 @@ void *scheme_enlarge_runstack(long size, void *(*k)())
saved->runstack_start = MZ_RUNSTACK_START;
saved->runstack_size = p->runstack_size;
size += TAIL_COPY_THRESHOLD;
if (size < SCHEME_STACK_SIZE)
size = SCHEME_STACK_SIZE;
size += SCHEME_TAIL_COPY_THRESHOLD;
/* If we keep growing the stack, then probably it
needs to be much larger, so at least double the stack size
each time: */
min_size = 2 * (p->runstack_size);
if (size < min_size)
size = min_size;
p->runstack_saved = saved;
if (p->spare_runstack && (size <= p->spare_runstack_size)) {
@ -4802,7 +4806,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
if (num_rands >= 0) {
if ((RUNSTACK - RUNSTACK_START) < TAIL_COPY_THRESHOLD) {
if ((RUNSTACK - RUNSTACK_START) < SCHEME_TAIL_COPY_THRESHOLD) {
/* It's possible that a sequence of primitive _scheme_tail_apply()
calls will exhaust the Scheme stack. Watch out for that. */
p->ku.k.p1 = (void *)obj;
@ -4814,7 +4818,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
if (rands == p->tail_buffer)
make_tail_buffer_safe();
MZ_CONT_MARK_POS -= 2;
return scheme_enlarge_runstack(100 * TAIL_COPY_THRESHOLD, (void *(*)(void))do_eval_k);
return scheme_enlarge_runstack(SCHEME_TAIL_COPY_THRESHOLD, (void *(*)(void))do_eval_k);
}
apply_top:
@ -4832,7 +4836,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
#define VACATE_TAIL_BUFFER_USE_RUNSTACK() \
if (rands == p->tail_buffer) { \
if (num_rands < TAIL_COPY_THRESHOLD) { \
if (num_rands < SCHEME_TAIL_COPY_THRESHOLD) { \
int i; \
Scheme_Object **quick_rands; \
\

2
src/mzscheme/src/fun.c
View File

@ -3102,8 +3102,6 @@ call_with_sema_enable_break(int argc, Scheme_Object *argv[])
return do_call_with_sema("call-with-semaphore/enable-break", 1, argc, argv);
}
#define TOTAL_STACK_SIZE (sizeof(Scheme_Object*) * SCHEME_STACK_SIZE)
static Scheme_Saved_Stack *copy_out_runstack(Scheme_Thread *p,
Scheme_Object **runstack,
Scheme_Object **runstack_start,

4
src/mzscheme/src/module.c
View File

@ -3095,7 +3095,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info)
start_simltaneous_b = m->body;
for (b = m->body; !SCHEME_NULLP(b); b = SCHEME_CDR(b)) {
/* Optimzie this expression: */
/* Optimize this expression: */
e = scheme_optimize_expr(SCHEME_CAR(b), info);
SCHEME_CAR(b) = e;
@ -3123,7 +3123,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info)
Scheme_Toplevel *tl;
tl = (Scheme_Toplevel *)SCHEME_CAR(vars);
if (!(SCHEME_TOPLEVEL_FLAGS(tl) & SCHEME_TOPLEVEL_MUTATED)) {
Scheme_Object *e2;

2
src/mzscheme/src/schminc.h
View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 862
#define EXPECTED_PRIM_COUNT 863
#ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP

2
src/mzscheme/src/schpriv.h
View File

@ -277,6 +277,8 @@ extern volatile int scheme_fuel_counter;
extern Scheme_Thread *scheme_main_thread;
#define SCHEME_TAIL_COPY_THRESHOLD 5
/* Flags for Scheme_Thread's `running' field: */
#define MZTHREAD_RUNNING 0x1
#define MZTHREAD_SUSPENDED 0x2

4
src/mzscheme/src/schvers.h
View File

@ -9,6 +9,6 @@
#define MZSCHEME_VERSION_MAJOR 301
#define MZSCHEME_VERSION_MINOR 13
#define MZSCHEME_VERSION_MINOR 14
#define MZSCHEME_VERSION "301.13" _MZ_SPECIAL_TAG
#define MZSCHEME_VERSION "301.14" _MZ_SPECIAL_TAG

68
src/mzscheme/src/thread.c
View File

@ -106,7 +106,8 @@ extern HANDLE scheme_break_semaphore;
#include "schfd.h"
#define INIT_SCHEME_STACK_SIZE 1000
#define DEFAULT_INIT_STACK_SIZE 1000
#define MAX_INIT_STACK_SIZE 100000
#ifdef SGC_STD_DEBUGGING
# define SENORA_GC_NO_FREE
@ -315,6 +316,8 @@ static Scheme_Object *make_thread_set(int argc, Scheme_Object *argv[]);
static Scheme_Object *thread_set_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *current_thread_set(int argc, Scheme_Object *argv[]);
static Scheme_Object *current_thread_initial_stack_size(int argc, Scheme_Object *argv[]);
static void adjust_custodian_family(void *pr, void *ignored);
static Scheme_Object *make_will_executor(int argc, Scheme_Object *args[]);
@ -717,6 +720,13 @@ void scheme_init_thread(Scheme_Env *env)
"choice-evt",
0, -1),
env);
scheme_add_global_constant("current-thread-initial-stack-size",
scheme_register_parameter(current_thread_initial_stack_size,
"current-thread-initial-stack-increment",
MZCONFIG_THREAD_INIT_STACK_SIZE),
env);
REGISTER_SO(namespace_options);
@ -1985,14 +1995,36 @@ static Scheme_Thread *make_thread(Scheme_Config *config,
process->tail_buffer = tb;
}
process->tail_buffer_size = buffer_init_size;
process->runstack_size = INIT_SCHEME_STACK_SIZE;
{
Scheme_Object **sa;
sa = scheme_malloc_allow_interior(sizeof(Scheme_Object*) * INIT_SCHEME_STACK_SIZE);
process->runstack_start = sa;
int init_stack_size;
Scheme_Object *iss;
iss = scheme_get_thread_param(config, cells, MZCONFIG_THREAD_INIT_STACK_SIZE);
if (SCHEME_INTP(iss))
init_stack_size = SCHEME_INT_VAL(iss);
else if (SCHEME_BIGNUMP(iss))
init_stack_size = 0x7FFFFFFF;
else
init_stack_size = DEFAULT_INIT_STACK_SIZE;
/* A too-large stack size won't help performance.
A too-small stack size is unsafe for certain kinds of
tail calls. */
if (init_stack_size > MAX_INIT_STACK_SIZE)
init_stack_size = MAX_INIT_STACK_SIZE;
if (init_stack_size < SCHEME_TAIL_COPY_THRESHOLD)
init_stack_size = SCHEME_TAIL_COPY_THRESHOLD;
process->runstack_size = init_stack_size;
{
Scheme_Object **sa;
sa = scheme_malloc_allow_interior(sizeof(Scheme_Object*) * init_stack_size);
process->runstack_start = sa;
}
process->runstack = process->runstack_start + init_stack_size;
}
process->runstack = process->runstack_start + INIT_SCHEME_STACK_SIZE;
process->runstack_saved = NULL;
#ifdef RUNSTACK_IS_GLOBAL
@ -5992,6 +6024,8 @@ static void make_initial_config(Scheme_Thread *p)
t_set = create_thread_set(NULL);
init_param(cells, paramz, MZCONFIG_THREAD_SET, (Scheme_Object *)t_set);
}
init_param(cells, paramz, MZCONFIG_THREAD_INIT_STACK_SIZE, scheme_make_integer(DEFAULT_INIT_STACK_SIZE));
{
int i;
@ -6113,6 +6147,26 @@ Scheme_Object *scheme_param_config(char *name, Scheme_Object *pos,
}
}
static Scheme_Object *
exact_positive_integer_p (int argc, Scheme_Object *argv[])
{
Scheme_Object *n = argv[0];
if (SCHEME_INTP(n) && (SCHEME_INT_VAL(n) > 0))
return scheme_true;
if (SCHEME_BIGNUMP(n) && SCHEME_BIGPOS(n))
return scheme_true;
return scheme_false;
}
static Scheme_Object *current_thread_initial_stack_size(int argc, Scheme_Object *argv[])
{
return scheme_param_config("current-thread-initial-stack-size",
scheme_make_integer(MZCONFIG_THREAD_INIT_STACK_SIZE),
argc, argv,
-1, exact_positive_integer_p, "exact positive integer", 0);
}
/*========================================================================*/
/* namespaces */
/*========================================================================*/