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

some stack-management clean-up from Kevin

Browse Source 
svn: r10668
This commit is contained in:
Matthew Flatt 2008-07-08 02:41:36 +00:00
parent 6756f05048
commit 7884610d38
10 changed files with 112 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
src/mred/mrmain.cxx
View File

@ -252,22 +252,9 @@ int actual_main(int argc, char **argv)
return r;
}
int main(int argc, char *argv[])
static int main_after_stack(void *data, int argc, char *argv[])
{
int rval;
void *stack_start;
stack_start = (void *)&stack_start;
/* Set stack base and turn off auto-finding of static variables ---
unless this is Windows, where scheme_set_stack_base
is called by wxWindows. */
#ifndef wx_msw
# if defined(MZ_PRECISE_GC)
stack_start = (void *)&__gc_var_stack__;
# endif
scheme_set_stack_base(stack_start, 1);
#endif
#ifdef wx_x
# if INTERRUPT_CHECK_ON
@ -305,6 +292,24 @@ int main(int argc, char *argv[])
return rval;
}
/* **************************************************************** */
/* Main for Unix and Mac OS X */
/* **************************************************************** */
/* Just jumps to generic main. */
#ifndef wx_msw
int main(int argc, char *argv[])
{
return scheme_main_stack_setup(1, main_after_stack, NULL, argc, argv);
}
#endif
/* **************************************************************** */
/* Main for Windows */
/* **************************************************************** */
/* Implements single-instance mode and otherwise initializes Windows. */
#ifdef wx_msw
@ -506,11 +511,36 @@ static char *CreateUniqueName()
return together;
}
/* To propagate args from WinMain to wxWinMain via
scheme_main_stack_setup: */
typedef struct {
int wm_is_mred;
HINSTANCE hInstance;
HINSTANCE hPrevInstance;
int nCmdShow;
} WinMain_Args;
static int call_main_after_stack(int argc, char *argv[])
{
return main_after_stack(NULL, argc, argv);
}
static int WinMain_after_stack(void *_wma, int argc, char **argv)
{
WinMain_Args *wma = (WinMain_Args *)_wma;
return wxWinMain(wma->wm_is_mred, wma->hInstance, wma->hPrevInstance,
argc, argv,
wma->nCmdShow,
call_main_after_stack);
}
int APIENTRY WinMain_dlls_ready(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR ignored, int nCmdShow)
{
LPWSTR m_lpCmdLine;
long argc, j, l;
char *a, **argv, *b, *normalized_path = NULL;
WinMain_Args wma;
/* Get command line: */
m_lpCmdLine = GetCommandLineW();
@ -595,7 +625,12 @@ int APIENTRY WinMain_dlls_ready(HINSTANCE hInstance, HINSTANCE hPrevInstance, LP
}
}
return wxWinMain(wm_is_mred, hInstance, hPrevInstance, argc, argv, nCmdShow, main);
wma.wm_is_mred = wm_is_mred;
wma.hInstance = hInstance;
wma.hPrevInstance = hPrevInstance;
wma.nCmdShow = nCmdShow;
return scheme_main_stack_setup(1, winMain_after_stack, &wma, argc, argv);
}
# ifdef MZ_PRECISE_GC

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

@ -1696,6 +1696,10 @@ MZ_EXTERN void scheme_set_actual_main(int (*m)(int argc, char **argv));
MZ_EXTERN void scheme_set_stack_base(void *base, int no_auto_statics);
MZ_EXTERN void scheme_set_stack_bounds(void *base, void *deepest, int no_auto_statics);
/* Stack-preparation start-up: */
typedef int (*Scheme_Startup_Main)(void *data, int argc, char **argv);
MZ_EXTERN int scheme_main_stack_setup(int no_auto_statics, Scheme_Startup_Main _main, void *data, int argc, char **argv);
/* More automatic start-up: */
typedef int (*Scheme_Main)(Scheme_Env *env, int argc, char **argv);
MZ_EXTERN int scheme_main_setup(int no_auto_statics, Scheme_Main _main, int argc, char **argv);

20
src/mzscheme/main.c
View File

@ -213,6 +213,7 @@ int actual_main(int argc, char *argv[]);
/* Prepare for delayload, then call main_after_dlls */
static int main_after_dlls(int argc, MAIN_char **MAIN_argv);
static int main_after_stack(void *data, int argc, MAIN_char **MAIN_argv);
# ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
@ -237,24 +238,23 @@ END_XFORM_SKIP;
# endif
/************************ main_after_dlls **************************/
/* Phase 1 setup, then call actual_main (indirectly) */
/* Prep stack for GC, then call main_after_stack (indirectly) */
static int main_after_dlls(int argc, MAIN_char **MAIN_argv)
{
void *stack_start;
return scheme_main_stack_setup(1, main_after_stack, NULL, argc, argv);
}
/************************ main_after_stack *************************/
/* Phase 1 setup, then call actual_main (indirectly) */
static int main_after_stack(void *data, int argc, MAIN_char **MAIN_argv)
{
int rval;
#ifdef WINDOWS_UNICODE_MAIN
char **argv;
#endif
stack_start = (void *)&stack_start;
#if defined(MZ_PRECISE_GC)
stack_start = (void *)&__gc_var_stack__;
#endif
scheme_set_stack_base(stack_start, 1);
#if defined(OSKIT) && !defined(OSKIT_TEST) && !KNIT
oskit_prepare(&argc, &argv);
#endif

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

@ -551,7 +551,7 @@ scheme_handle_stack_overflow(Scheme_Object *(*k)(void))
scheme_init_jmpup_buf(&overflow->jmp->cont);
scheme_zero_unneeded_rands(scheme_current_thread); /* for GC */
if (scheme_setjmpup(&overflow->jmp->cont, overflow->jmp, ADJUST_STACK_START(p->stack_start))) {
if (scheme_setjmpup(&overflow->jmp->cont, overflow->jmp, p->stack_start)) {
p = scheme_current_thread;
overflow = p->overflow;
p->overflow = overflow->prev;

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

@ -1809,12 +1809,6 @@ void scheme_really_create_overflow(void *stack_base)
{
Scheme_Overflow_Jmp *jmp;
/* Even if we already have scheme_overflow_jmp,
it's possible that we're starting at a lower stack position
than previously. It's important (for non-3m) to declare
the new stack start: */
scheme_ensure_stack_start(stack_base);
if (scheme_overflow_jmp)
return;
@ -1896,9 +1890,9 @@ void scheme_really_create_overflow(void *stack_base)
void scheme_create_overflow(void)
{
void *dummy;
scheme_really_create_overflow(PROMPT_STACK(dummy));
dummy = NULL; /* to ensure that we get __gc_var_stack__ in 3m */
void *stack_marker;
scheme_really_create_overflow(PROMPT_STACK(stack_marker));
stack_marker = NULL; /* to ensure that we get __gc_var_stack__ in 3m */
}
void scheme_init_overflow(void)
@ -5435,7 +5429,7 @@ internal_call_cc (int argc, Scheme_Object *argv[])
else if (meta_prompt)
stack_start = meta_prompt->stack_boundary;
else
stack_start = ADJUST_STACK_START(p->stack_start);
stack_start = p->stack_start;
}
}
@ -5768,10 +5762,6 @@ Scheme_Object *scheme_apply_for_prompt(Scheme_Prompt *prompt, Scheme_Object *pro
/* Grab stack address, then continue on with final step: */
prompt->stack_boundary = PROMPT_STACK(proc);
/* Even if all threads start deeper, a continuation might be sent
to the thread to start it at this prompt's stack level. */
scheme_ensure_stack_start(prompt->stack_boundary);
proc = scheme_finish_apply_for_prompt(prompt, prompt_tag, proc, argc, argv);
return proc;
@ -5827,7 +5817,7 @@ static Scheme_Object *compose_continuation(Scheme_Cont *cont, int exec_chain,
if (scheme_setjmpup(&offstack_overflow->jmp->cont,
offstack_overflow->jmp,
ADJUST_STACK_START(p->stack_start))) {
p->stack_start)) {
/* Returning. (Jumped here from finish_apply_for_prompt,
scheme_compose_continuation, scheme_eval, or start_child.)

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

@ -7383,7 +7383,7 @@ Scheme_Object *scheme_native_stack_trace(void)
stack_end -= (RETURN_ADDRESS_OFFSET << JIT_LOG_WORD_SIZE);
tail = stack_cache_stack[stack_cache_stack_pos].cache;
} else {
stack_end = (unsigned long)ADJUST_STACK_START(scheme_current_thread->stack_start);
stack_end = (unsigned long)scheme_current_thread->stack_start;
tail = scheme_null;
}
@ -7491,7 +7491,7 @@ void scheme_dump_stack_trace(void)
p = gs();
stack_start = scheme_approx_sp();
stack_end = (unsigned long)ADJUST_STACK_START(scheme_current_thread->stack_start);
stack_end = (unsigned long)scheme_current_thread->stack_start;
while (STK_COMP((unsigned long)p, stack_end)
&& STK_COMP(stack_start, (unsigned long)p)) {

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

@ -88,22 +88,38 @@ void scheme_set_stack_base(void *base, int no_auto_statics)
use_registered_statics = no_auto_statics;
}
typedef struct {
Scheme_Main _main;
} Scheme_Main_Data;
static int call_with_basic(void *data, int argc, char **argv)
{
Scheme_Main _main = ((Scheme_Main_Data *)data)->_main;
return _main(scheme_basic_env(), argc, argv);
}
int scheme_main_setup(int no_auto_statics, Scheme_Main _main, int argc, char **argv)
{
void *start_addr = &start_addr;
Scheme_Main_Data d;
d._main = _main;
return scheme_main_stack_setup(no_auto_statics, call_with_basic, &d, argc, argv);
}
#ifdef MZ_PRECISE_GC
start_addr = &__gc_var_stack__;
#endif
scheme_set_stack_base(start_addr, no_auto_statics);
int scheme_main_stack_setup(int no_auto_statics, Scheme_Startup_Main _main, void *data, int argc, char **argv)
{
void *stack_start;
int volatile return_code;
scheme_set_stack_base(PROMPT_STACK(stack_start), no_auto_statics);
return_code = _main(data, argc, argv);
#ifdef MZ_PRECISE_GC
/* Trick xform conversion to keep start_addr: */
start_addr = start_addr;
stack_start = NULL;
#endif
return _main(scheme_basic_env(), argc, argv);
return return_code;
}
void scheme_set_stack_bounds(void *base, void *deepest, int no_auto_statics)

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

@ -973,15 +973,10 @@ Scheme_Object *scheme_handle_stack_overflow(Scheme_Object *(*k)(void));
extern struct Scheme_Overflow_Jmp *scheme_overflow_jmp;
extern void *scheme_overflow_stack_start;
void scheme_ensure_stack_start(void *d);
extern void *scheme_deepest_stack_start;
#ifdef MZ_PRECISE_GC
# define PROMPT_STACK(id) &__gc_var_stack__
# define ADJUST_STACK_START(start) (start)
#else
# define PROMPT_STACK(id) ((void *)(&id))
# define ADJUST_STACK_START(start) (start ? start : scheme_deepest_stack_start)
#endif
struct Scheme_Overflow_Jmp *scheme_prune_jmpup(struct Scheme_Overflow_Jmp *jmp, void *stack_boundary);

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

@ -162,8 +162,6 @@ Scheme_Thread_Set *thread_set_top;
static int num_running_threads = 1;
void *scheme_deepest_stack_start;
#ifdef LINK_EXTENSIONS_BY_TABLE
Scheme_Thread **scheme_current_thread_ptr;
volatile int *scheme_fuel_counter_ptr;
@ -423,7 +421,7 @@ typedef struct {
static int num_nsos = 0;
static Scheme_NSO *namespace_options = NULL;
#define SETJMP(p) scheme_setjmpup(&p->jmpup_buf, p, ADJUST_STACK_START(p->stack_start))
#define SETJMP(p) scheme_setjmpup(&p->jmpup_buf, p, p->stack_start)
#define LONGJMP(p) scheme_longjmpup(&p->jmpup_buf)
#define RESETJMP(p) scheme_reset_jmpup_buf(&p->jmpup_buf)
@ -2081,8 +2079,6 @@ static Scheme_Thread *make_thread(Scheme_Config *config,
process->so.type = scheme_thread_type;
process->stack_start = 0;
if (!scheme_main_thread) {
/* Creating the first thread... */
#ifdef MZ_PRECISE_GC
@ -2114,15 +2110,24 @@ static Scheme_Thread *make_thread(Scheme_Config *config,
scheme_current_thread_ptr = &scheme_current_thread;
scheme_fuel_counter_ptr = &scheme_fuel_counter;
#endif
#ifdef MZ_PRECISE_GC
/* Before a thread can be used stack_start must be set
* this code sets stack_start for the main_thread
* which is created with scheme_make_thread.
*
* make_subprocess is the only other caller of make_thread
* and it sets stack_start */
#if defined(MZ_PRECISE_GC) || defined(USE_SENORA_GC)
{
void *ss;
ss = (void *)GC_get_stack_base();
process->stack_start = ss;
}
GC_get_thread_stack_base = get_current_stack_start;
#else
process->stack_start = GC_stackbottom;
#endif
} else {
prefix = 1;
}
@ -2814,13 +2819,6 @@ static void start_child(Scheme_Thread * volatile child,
}
}
void scheme_ensure_stack_start(void *d)
{
if (!scheme_deepest_stack_start
|| (STK_COMP((unsigned long)scheme_deepest_stack_start, (unsigned long)d)))
scheme_deepest_stack_start = d;
}
static Scheme_Object *make_subprocess(Scheme_Object *child_thunk,
void *child_start,
Scheme_Config *config,
@ -2834,8 +2832,6 @@ static Scheme_Object *make_subprocess(Scheme_Object *child_thunk,
turn_on_multi = !scheme_first_thread->next;
scheme_ensure_stack_start(child_start);
if (!config)
config = scheme_current_config();
if (!cells)
@ -3073,9 +3069,7 @@ Scheme_Object *scheme_thread_w_details(Scheme_Object *thunk,
int suspend_to_kill)
{
Scheme_Object *result;
#ifndef MZ_PRECISE_GC
long dummy;
#endif
void *stack_marker;
#ifdef DO_STACK_CHECK
/* Make sure the thread starts out with a reasonable stack size, so
@ -3098,12 +3092,7 @@ Scheme_Object *scheme_thread_w_details(Scheme_Object *thunk,
}
#endif
result = make_subprocess(thunk,
#ifdef MZ_PRECISE_GC
(void *)&__gc_var_stack__,
#else
(void *)&dummy,
#endif
result = make_subprocess(thunk, PROMPT_STACK(stack_marker),
config, cells, break_cell, mgr, !suspend_to_kill);
/* Don't get rid of `result'; it keeps the
@ -3192,8 +3181,6 @@ Scheme_Object *scheme_call_as_nested_thread(int argc, Scheme_Object *argv[], voi
}
np->tail_buffer_size = p->tail_buffer_size;
scheme_ensure_stack_start(max_bottom);
np->list_stack = p->list_stack;
np->list_stack_pos = p->list_stack_pos;
@ -7240,7 +7227,7 @@ static Scheme_Object *current_stats(int argc, Scheme_Object *argv[])
/* C stack */
if (t == scheme_current_thread) {
void *stk_start, *stk_end;
stk_start = ADJUST_STACK_START(t->stack_start);
stk_start = t->stack_start;
stk_end = (void *)&stk_end;
# ifdef STACK_GROWS_UP
sz = (long)stk_end XFORM_OK_MINUS (long)stk_start;
@ -7365,7 +7352,7 @@ static unsigned long get_current_stack_start(void)
{
Scheme_Thread *p;
p = scheme_current_thread;
return (unsigned long)ADJUST_STACK_START(p->stack_start);
return (unsigned long)p->stack_start;
}
#endif

11
src/wxwindow/src/msw/wx_main.cxx
View File

@ -181,7 +181,6 @@ static int retValue = 0;
extern void wxCreateApp(void);
extern void wxStartEndSessionThread();
extern "C" __declspec(dllimport) void scheme_set_stack_base(void *, int);
int WM_IS_MRED;
@ -190,16 +189,6 @@ int wxWinMain(int wm_is_mred,
int count, char **command, int nCmdShow,
int (*main)(int, char**))
{
void *mzscheme_stack_start;
mzscheme_stack_start = (void *)&mzscheme_stack_start;
#if defined(MZ_PRECISE_GC)
mzscheme_stack_start = (void *)&__gc_var_stack__;
#endif
scheme_set_stack_base(mzscheme_stack_start, 1);
wxhInstance = hInstance;
WM_IS_MRED = wm_is_mred;