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

369.2, forgot some MrEd changes

Browse Source 
svn: r5146
This commit is contained in:
Matthew Flatt 2006-12-20 02:33:21 +00:00
parent f33173e47b
commit 2d3ceeed15
3 changed files with 35 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
src/mred/mred.cxx
View File

@ -250,7 +250,7 @@ static Scheme_Type mred_eventspace_hop_type;
static Scheme_Object *def_dispatch; static Scheme_Object *def_dispatch;
int mred_ps_setup_param; int mred_ps_setup_param;
#ifdef NEED_HET_PARAM #ifdef NEED_HET_PARAM
int mred_het_param; Scheme_Object *mred_het_key;
#endif #endif
typedef struct Nested_Wait { typedef struct Nested_Wait {
@ -778,10 +778,6 @@ static MrEdContext *MakeContext(MrEdContext *c)
mred_eventspace_param, mred_eventspace_param,
(Scheme_Object *)c); (Scheme_Object *)c);
#ifdef NEED_HET_PARAM
config = scheme_extend_config(config, mred_het_param, scheme_false);
#endif
c->main_config = config; c->main_config = config;
cells = scheme_inherit_cells(NULL); cells = scheme_inherit_cells(NULL);
c->main_cells = cells; c->main_cells = cells;
@ -1037,12 +1033,12 @@ int mred_current_thread_is_handler(void *ctx)
int mred_in_restricted_context() int mred_in_restricted_context()
{ {
#ifdef NEED_HET_PARAM #ifdef NEED_HET_PARAM
/* see wxHiEventTrampoline for info on mred_het_param: */ /* see wxHiEventTrampoline for info on mred_het_key: */
Scheme_Object *v; Scheme_Object *v;
if (!scheme_current_thread) if (!scheme_current_thread)
return 1; return 1;
v = scheme_get_param(scheme_current_thread->init_config, mred_het_param); v = scheme_extract_one_cc_mark(NULL, mred_het_key);
if (SCHEME_TRUEP(v)) if (v && SCHEME_BOX_VAL(v))
return 1; return 1;
#endif #endif
return 0; return 0;
@ -1219,11 +1215,11 @@ static Scheme_Object *MrEdDoNextEvent(MrEdContext *c, wxDispatch_Check_Fun alt,
int restricted = 0; int restricted = 0;
#ifdef NEED_HET_PARAM #ifdef NEED_HET_PARAM
/* see wxHiEventTrampoline for info on mred_het_param: */ /* see wxHiEventTrampoline for info on mred_het_key: */
{ {
Scheme_Object *v; Scheme_Object *v;
v = scheme_get_param(scheme_current_thread->init_config, mred_het_param); v = scheme_extract_one_cc_mark(NULL, mred_het_key);
if (SCHEME_TRUEP(v)) if (v && SCHEME_BOX_VAL(v))
restricted = 1; restricted = 1;
} }
#endif #endif
@ -1335,11 +1331,11 @@ int MrEdEventReady(MrEdContext *c)
int restricted = 0; int restricted = 0;
#ifdef NEED_HET_PARAM #ifdef NEED_HET_PARAM
/* see wxHiEventTrampoline for info on mred_het_param: */ /* see wxHiEventTrampoline for info on mred_het_key: */
{ {
Scheme_Object *v; Scheme_Object *v;
v = scheme_get_param(scheme_current_thread->init_config, mred_het_param); v = scheme_extract_one_cc_mark(NULL, mred_het_key);
if (SCHEME_TRUEP(v)) if (v && SCHEME_BOX_VAL(v))
restricted = 1; restricted = 1;
} }
#endif #endif
@ -3271,7 +3267,8 @@ wxFrame *MrEdApp::OnInit(void)
mred_event_dispatch_param = scheme_new_param(); mred_event_dispatch_param = scheme_new_param();
mred_ps_setup_param = scheme_new_param(); mred_ps_setup_param = scheme_new_param();
#ifdef NEED_HET_PARAM #ifdef NEED_HET_PARAM
mred_het_param = scheme_new_param(); wxREGGLOB(mred_het_key);
mred_het_key = scheme_make_symbol("het"); /* uninterned */
#endif #endif
wxInitSnips(); /* and snip classes */ wxInitSnips(); /* and snip classes */
@ -3608,50 +3605,26 @@ extern "C" {
static unsigned long get_deeper_base(); static unsigned long get_deeper_base();
static void pre_het(void *d) int wxHiEventTrampoline(int (*_wha_f)(void *), void *wha_data)
{
HiEventTramp *het = (HiEventTramp *)d;
het->old_param = scheme_get_param(het->config, mred_het_param);
scheme_set_param(het->config, mred_het_param, scheme_make_raw_pair((Scheme_Object *)het, scheme_null));
}
static Scheme_Object *act_het(void *d)
{
HiEventTramp * het = (HiEventTramp *)d;
HiEventTrampProc wha_f = het->wrap_het_around_f;
het->val = wha_f(het->wha_data);
return scheme_void;
}
static void post_het(void *d)
{
HiEventTramp *het = (HiEventTramp *)d;
scheme_set_param(het->config, mred_het_param, het->old_param);
}
int wxHiEventTrampoline(int (*wha_f)(void *), void *wha_data)
{ {
HiEventTramp *het; HiEventTramp *het;
HiEventTrampProc wha_f = (HiEventTrampProc)_wha_f;
Scheme_Cont_Frame_Data cframe;
Scheme_Object *bx;
het = new WXGC_PTRS HiEventTramp; het = new WXGC_PTRS HiEventTramp;
het->wrap_het_around_f = wha_f;
het->wha_data = wha_data; bx = scheme_make_raw_pair((Scheme_Object *)het, NULL);
het->val = 0;
het->config = scheme_current_thread->init_config; scheme_push_continuation_frame(&cframe);
scheme_set_cont_mark(mred_het_key, bx);
het->progress_cont = scheme_new_jmpupbuf_holder(); het->progress_cont = scheme_new_jmpupbuf_holder();
scheme_init_jmpup_buf(&het->progress_cont->buf); scheme_init_jmpup_buf(&het->progress_cont->buf);
scheme_start_atomic(); scheme_start_atomic();
scheme_dynamic_wind(CAST_DW_PRE pre_het, het->val = wha_f(wha_data);
CAST_DW_RUN act_het,
CAST_DW_POST post_het,
NULL, het);
if (het->timer_on) { if (het->timer_on) {
het->timer_on = 0; het->timer_on = 0;
@ -3666,6 +3639,7 @@ int wxHiEventTrampoline(int (*wha_f)(void *), void *wha_data)
point might be trying to suspend the thread (and that should point might be trying to suspend the thread (and that should
complete before any swap). */ complete before any swap). */
scheme_end_atomic_no_swap(); scheme_end_atomic_no_swap();
SCHEME_CAR(bx) = NULL;
het->in_progress = 0; het->in_progress = 0;
het->progress_is_resumed = 1; het->progress_is_resumed = 1;
if (!scheme_setjmp(het->progress_base)) { if (!scheme_setjmp(het->progress_base)) {
@ -3678,9 +3652,10 @@ int wxHiEventTrampoline(int (*wha_f)(void *), void *wha_data)
scheme_end_atomic(); scheme_end_atomic();
} }
scheme_pop_continuation_frame(&cframe);
het->old_param = NULL; het->old_param = NULL;
het->progress_cont = NULL; het->progress_cont = NULL;
het->wha_data = NULL;
het->do_data = NULL; het->do_data = NULL;
return het->val; return het->val;
@ -3692,7 +3667,7 @@ static void suspend_het_progress(void)
{ {
Scheme_Object *v; Scheme_Object *v;
v = scheme_get_param(scheme_current_thread->init_config, mred_het_param); v = scheme_extract_one_cc_mark(NULL, mred_het_key);
het = (HiEventTramp *)SCHEME_CAR(v); het = (HiEventTramp *)SCHEME_CAR(v);
} }
@ -3770,8 +3745,8 @@ int mred_het_run_some(HiEventTrampProc do_f, void *do_data)
{ {
Scheme_Object *v; Scheme_Object *v;
v = scheme_get_param(scheme_current_thread->init_config, mred_het_param); v = scheme_extract_one_cc_mark(NULL, mred_het_key);
if (SCHEME_RPAIRP(v)) if (v)
het = (HiEventTramp *)SCHEME_CAR(v); het = (HiEventTramp *)SCHEME_CAR(v);
else else
het = NULL; het = NULL;

4
src/mred/mred.h
View File

@ -134,8 +134,6 @@ typedef int (*HiEventTrampProc)(void *);
class HiEventTramp { class HiEventTramp {
public: public:
HiEventTrampProc wrap_het_around_f;
void *wha_data;
HiEventTrampProc do_f; HiEventTrampProc do_f;
void *do_data; void *do_data;
int val; int val;
@ -156,7 +154,7 @@ public:
int mred_het_run_some(HiEventTrampProc do_f, void *do_data); int mred_het_run_some(HiEventTrampProc do_f, void *do_data);
extern int mred_het_param; extern Scheme_Object *mred_het_key;
int wxHiEventTrampoline(HiEventTrampProc wha_f, void *wha_data); int wxHiEventTrampoline(HiEventTrampProc wha_f, void *wha_data);

12
src/mred/mredmsw.cxx
View File

@ -566,8 +566,8 @@ int wx_start_win_event(const char *who, HWND hWnd, UINT message, WPARAM wParam,
Scheme_Object *v; Scheme_Object *v;
HiEventTramp *het; HiEventTramp *het;
v = scheme_get_param(scheme_current_thread->init_config, mred_het_param); v = scheme_extract_one_cc_mark(NULL, mred_het_key);
if (SCHEME_FALSEP(v)) if (!v)
het = NULL; het = NULL;
else else
het = (HiEventTramp *)SCHEME_CAR(v); het = (HiEventTramp *)SCHEME_CAR(v);
@ -740,8 +740,8 @@ void wx_end_win_event(const char *who, HWND hWnd, UINT message, int tramp)
HiEventTramp *het; HiEventTramp *het;
Scheme_Object *v; Scheme_Object *v;
v = scheme_get_param(scheme_current_thread->init_config, mred_het_param); v = scheme_extract_one_cc_mark(NULL, mred_het_key);
if (SCHEME_FALSEP(v)) if (!v)
het = NULL; het = NULL;
else else
het = (HiEventTramp *)SCHEME_CAR(v); het = (HiEventTramp *)SCHEME_CAR(v);
@ -780,8 +780,8 @@ static void CALLBACK HETRunSome(HWND hwnd, UINT uMsg, UINT idEvent, DWORD dwTime
HiEventTramp *het; HiEventTramp *het;
Scheme_Object *v; Scheme_Object *v;
v = scheme_get_param(scheme_current_thread->init_config, mred_het_param); v = scheme_extract_one_cc_mark(NULL, mred_het_key);
if (SCHEME_FALSEP(v)) if (!v)
het = NULL; het = NULL;
else else
het = (HiEventTramp *)SCHEME_CAR(v); het = (HiEventTramp *)SCHEME_CAR(v);