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

Add proxy-able continuation mark keys and proxies

Browse Source 
(with much help from Matthew on the JIT side)
This commit is contained in:
Asumu Takikawa 2012-06-12 16:18:41 -04:00
parent 1e115e2963
commit db6c37df92
20 changed files with 1147 additions and 776 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
collects/tests/racket/contmark.rktl
View File

@ -915,6 +915,87 @@
pt)))))
pt)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test proxy-able continuation marks
(let ()
(define my-mark (make-continuation-mark-key 'my-mark))
(wcm-test '(secret)
(lambda ()
(with-continuation-mark my-mark 'secret
(extract-current-continuation-marks my-mark))))
(wcm-test '()
(lambda ()
(with-continuation-mark my-mark 'secret
(extract-current-continuation-marks 'my-mark))))
(define my-mark-2 (make-continuation-mark-key 'my-mark))
(wcm-test '()
(lambda ()
(with-continuation-mark my-mark 'secret
(extract-current-continuation-marks my-mark-2)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests for continuation mark proxies
(let ()
(define imp-mark
(impersonate-continuation-mark-key
(make-continuation-mark-key)
(lambda (x) (* x 2))
(lambda (x) (+ x 1))))
(define cha-mark
(chaperone-continuation-mark-key
(make-continuation-mark-key)
(lambda (x) (if (number? x) x (error "fail")))
(lambda (x) x)))
(define bad-mark
(chaperone-continuation-mark-key
(make-continuation-mark-key)
(lambda (x) 42)
(lambda (x) x)))
(define bad-mark-2
(chaperone-continuation-mark-key
(make-continuation-mark-key)
(lambda (x) x)
(lambda (x) 42)))
(define (do-test mark val)
(with-continuation-mark mark val
(extract-current-continuation-marks mark)))
(define (do-test* mark val)
(with-continuation-mark mark val
(continuation-mark-set->list*
(current-continuation-marks)
(list mark))))
(define (do-test/first mark val)
(with-continuation-mark mark val
(continuation-mark-set-first (current-continuation-marks) mark)))
(define (do-test/immediate mark val)
(with-continuation-mark mark val
(call-with-immediate-continuation-mark mark
(lambda (v) v))))
(wcm-test '(12) (lambda () (do-test imp-mark 5)))
(wcm-test '(#(12)) (lambda () (do-test* imp-mark 5)))
(wcm-test 12 (lambda () (do-test/first imp-mark 5)))
(wcm-test 12 (lambda () (do-test/immediate imp-mark 5)))
(wcm-test '(5) (lambda () (do-test cha-mark 5)))
(wcm-test '(#(5)) (lambda () (do-test* cha-mark 5)))
(wcm-test 5 (lambda () (do-test/first cha-mark 5)))
(wcm-test 5 (lambda () (do-test/immediate cha-mark 5)))
(err/rt-test (do-test cha-mark "fail") exn:fail?)
(err/rt-test (do-test bad-mark 5) exn:fail?))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

5
doc/release-notes/racket/HISTORY.txt
View File

@ -1,3 +1,8 @@
Version 5.3.0.12
racket/base: added impersonate-continuation-mark-key,
chaperone-continuation-mark-key, make-continuation-mark-key,
continuation-mark-key?
Version 5.3.0.11
Changed contract on date second field to disallow 61, since
leap seconds never appear more than once per minute

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

@ -451,6 +451,7 @@ typedef intptr_t (*Scheme_Secondary_Hash_Proc)(Scheme_Object *obj, void *cycle_d
#define SCHEME_IMMUTABLE_BOXP(obj) (SCHEME_BOXP(obj) && SCHEME_IMMUTABLEP(obj))
#define SCHEME_PROMPT_TAGP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_prompt_tag_type)
#define SCHEME_CONTINUATION_MARK_KEYP(obj) SAME_TYPE(SCHEME_TYPE(obj), scheme_continuation_mark_key_type)
#define SCHEME_BUCKTP(obj) SAME_TYPE(SCHEME_TYPE(obj),scheme_bucket_table_type)
#define SCHEME_HASHTP(obj) SAME_TYPE(SCHEME_TYPE(obj),scheme_hash_table_type)

1330
src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

6
src/racket/src/eval.c
View File

@ -3559,6 +3559,12 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
if (SCHEME_TYPE(val) < _scheme_values_types_)
val = _scheme_eval_linked_expr_wp(val, p);
if (SCHEME_NP_CHAPERONEP(key)
&& SCHEME_CONTINUATION_MARK_KEYP(SCHEME_CHAPERONE_VAL(key))) {
val = scheme_chaperone_do_continuation_mark("with-continuation-mark", 0, key, val);
key = SCHEME_CHAPERONE_VAL(key);
}
scheme_set_cont_mark(key, val);
obj = wcm->body;

185
src/racket/src/fun.c
View File

@ -143,6 +143,10 @@ static Scheme_Object *impersonate_prompt_tag (int argc, Scheme_Object *argv[]);
static Scheme_Object *chaperone_prompt_tag (int argc, Scheme_Object *argv[]);
static Scheme_Object *call_with_sema (int argc, Scheme_Object *argv[]);
static Scheme_Object *call_with_sema_enable_break (int argc, Scheme_Object *argv[]);
static Scheme_Object *make_continuation_mark_key (int argc, Scheme_Object *argv[]);
static Scheme_Object *continuation_mark_key_p (int argc, Scheme_Object *argv[]);
static Scheme_Object *impersonate_continuation_mark_key (int argc, Scheme_Object *argv[]);
static Scheme_Object *chaperone_continuation_mark_key (int argc, Scheme_Object *argv[]);
static Scheme_Object *cc_marks (int argc, Scheme_Object *argv[]);
static Scheme_Object *cont_marks (int argc, Scheme_Object *argv[]);
static Scheme_Object *cc_marks_p (int argc, Scheme_Object *argv[]);
@ -395,6 +399,27 @@ scheme_init_fun (Scheme_Env *env)
0, -1),
env);
scheme_add_global_constant("make-continuation-mark-key",
scheme_make_prim_w_arity(make_continuation_mark_key,
"make-continuation-mark-key",
0, 1),
env);
scheme_add_global_constant("continuation-mark-key?",
scheme_make_prim_w_arity(continuation_mark_key_p,
"continuation-mark-key?",
1, 1),
env);
scheme_add_global_constant("impersonate-continuation-mark-key",
scheme_make_prim_w_arity(impersonate_continuation_mark_key,
"impersonate-continuation-mark-key",
3, -1),
env);
scheme_add_global_constant("chaperone-continuation-mark-key",
scheme_make_prim_w_arity(chaperone_continuation_mark_key,
"chaperone-continuation-mark-key",
3, -1),
env);
scheme_add_global_constant("current-continuation-marks",
scheme_make_prim_w_arity(cc_marks,
"current-continuation-marks",
@ -3742,6 +3767,100 @@ int scheme_escape_continuation_ok(Scheme_Object *ec)
return 0;
}
static Scheme_Object *make_continuation_mark_key (int argc, Scheme_Object *argv[])
{
Scheme_Object *o;
if (argc && !SCHEME_SYMBOLP(argv[0]))
scheme_wrong_contract("make-continuation-mark-key", "symbol?", 0, argc, argv);
o = scheme_alloc_small_object();
o->type = scheme_continuation_mark_key_type;
SCHEME_PTR_VAL(o) = (argc ? argv[0] : NULL);
return o;
}
static Scheme_Object *continuation_mark_key_p (int argc, Scheme_Object *argv[])
{
return (SCHEME_CHAPERONE_CONTINUATION_MARK_KEYP(argv[0])
? scheme_true
: scheme_false);
}
Scheme_Object *scheme_chaperone_do_continuation_mark (const char *name, int is_get, Scheme_Object *key, Scheme_Object *val)
{
Scheme_Chaperone *px;
Scheme_Object *proc;
Scheme_Object *a[1];
while (1) {
if (SCHEME_CONTINUATION_MARK_KEYP(key)) {
return val;
} else {
px = (Scheme_Chaperone *)key;
key = px->prev;
if (is_get)
proc = SCHEME_CAR(px->redirects);
else
proc = SCHEME_CDR(px->redirects);
a[0] = val;
val = _scheme_apply(proc, 1, a);
if (!(SCHEME_CHAPERONE_FLAGS(px) & SCHEME_CHAPERONE_IS_IMPERSONATOR)) {
if (!scheme_chaperone_of(val, a[0]))
scheme_wrong_chaperoned(name, "value", a[0], val);
}
}
}
}
Scheme_Object *do_chaperone_continuation_mark_key (const char *name, int is_impersonator, int argc, Scheme_Object **argv)
{
Scheme_Chaperone *px;
Scheme_Object *val = argv[0];
Scheme_Object *redirects;
Scheme_Hash_Tree *props;
if (SCHEME_CHAPERONEP(val))
val = SCHEME_CHAPERONE_VAL(val);
if (!SCHEME_CONTINUATION_MARK_KEYP(val))
scheme_wrong_contract(name, "continuation-mark-key?", 0, argc, argv);
scheme_check_proc_arity(name, 1, 1, argc, argv);
scheme_check_proc_arity(name, 1, 2, argc, argv);
redirects = scheme_make_pair(argv[1], argv[2]);
props = scheme_parse_chaperone_props(name, 3, argc, argv);
px = MALLOC_ONE_TAGGED(Scheme_Chaperone);
px->iso.so.type = scheme_chaperone_type;
px->val = val;
px->prev = argv[0];
px->props = props;
px->redirects = redirects;
if (is_impersonator)
SCHEME_CHAPERONE_FLAGS(px) |= SCHEME_CHAPERONE_IS_IMPERSONATOR;
return (Scheme_Object *)px;
}
static Scheme_Object *chaperone_continuation_mark_key(int argc, Scheme_Object **argv)
{
return do_chaperone_continuation_mark_key("chaperone-continuation-mark-key", 0, argc, argv);
}
static Scheme_Object *impersonate_continuation_mark_key(int argc, Scheme_Object **argv)
{
return do_chaperone_continuation_mark_key("impersonate-continuation-mark-key", 1, argc, argv);
}
static Scheme_Object *call_with_immediate_cc_mark (int argc, Scheme_Object *argv[])
{
Scheme_Thread *p = scheme_current_thread;
@ -3751,6 +3870,10 @@ static Scheme_Object *call_with_immediate_cc_mark (int argc, Scheme_Object *argv
scheme_check_proc_arity("call-with-immediate-continuation-mark", 1, 1, argc, argv);
key = argv[0];
if (SCHEME_NP_CHAPERONEP(key)
&& SCHEME_CONTINUATION_MARK_KEYP(SCHEME_CHAPERONE_VAL(key)))
key = SCHEME_CHAPERONE_VAL(key);
if (argc > 2)
a[0] = argv[2];
else
@ -3768,7 +3891,16 @@ static Scheme_Object *call_with_immediate_cc_mark (int argc, Scheme_Object *argv
break;
} else {
if (find->key == key) {
a[0] = find->val;
/*
* If not equal, it was a chaperone since we unwrapped the key
*/
if (argv[0] != key) {
Scheme_Object *val;
val = scheme_chaperone_do_continuation_mark("call-with-immediate-continuation-mark",
1, argv[0], find->val);
a[0] = val;
} else
a[0] = find->val;
break;
}
}
@ -7093,7 +7225,9 @@ extract_cc_marks(int argc, Scheme_Object *argv[])
{
Scheme_Cont_Mark_Chain *chain;
Scheme_Object *first = scheme_null, *last = NULL, *key, *prompt_tag;
Scheme_Object *v;
Scheme_Object *pr;
int is_chaperoned = 0;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_cont_mark_set_type)) {
scheme_wrong_contract("continuation-mark-set->list", "continuation-mark-set?", 0, argc, argv);
@ -7124,11 +7258,22 @@ extract_cc_marks(int argc, Scheme_Object *argv[])
return NULL;
}
if (SCHEME_NP_CHAPERONEP(key)
&& SCHEME_CONTINUATION_MARK_KEYP(SCHEME_CHAPERONE_VAL(key))) {
is_chaperoned = 1;
key = SCHEME_CHAPERONE_VAL(key);
}
prompt_tag = SCHEME_PTR_VAL(prompt_tag);
while (chain) {
if (chain->key == key) {
pr = scheme_make_pair(chain->val, scheme_null);
if (is_chaperoned)
v = scheme_chaperone_do_continuation_mark("continuation-mark-set->list",
1, argv[1], chain->val);
else
v = chain->val;
pr = scheme_make_pair(v, scheme_null);
if (last)
SCHEME_CDR(last) = pr;
else
@ -7198,8 +7343,17 @@ extract_cc_markses(int argc, Scheme_Object *argv[])
while (chain) {
for (i = 0; i < len; i++) {
int is_chaperoned = 0;
Scheme_Object *orig_key, *val;
if (SCHEME_MARK_CHAIN_FLAG(chain) & 0x1)
last_pos = -1;
if (SCHEME_NP_CHAPERONEP(keys[i])
&& SCHEME_CONTINUATION_MARK_KEYP(SCHEME_CHAPERONE_VAL(keys[i]))) {
is_chaperoned = 1;
orig_key = keys[i];
keys[i] = SCHEME_CHAPERONE_VAL(orig_key);
}
if (SAME_OBJ(chain->key, keys[i])) {
intptr_t pos;
pos = (intptr_t)chain->pos;
@ -7214,7 +7368,12 @@ extract_cc_markses(int argc, Scheme_Object *argv[])
last = pr;
} else
vals = SCHEME_CAR(last);
SCHEME_VEC_ELS(vals)[i] = chain->val;
if (is_chaperoned) {
val = scheme_chaperone_do_continuation_mark("continuation-mark-set->list*",
1, orig_key, chain->val);
SCHEME_VEC_ELS(vals)[i] = val;
} else
SCHEME_VEC_ELS(vals)[i] = chain->val;
}
}
@ -7324,16 +7483,30 @@ extract_cc_proc_marks(int argc, Scheme_Object *argv[])
}
static Scheme_Object *
scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key,
scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key_arg,
Scheme_Object *prompt_tag, Scheme_Meta_Continuation **_meta,
MZ_MARK_POS_TYPE *_vpos)
{
Scheme_Object *key = key_arg;
if (SCHEME_NP_CHAPERONEP(key)
&& SCHEME_CONTINUATION_MARK_KEYP(SCHEME_CHAPERONE_VAL(key))) {
key = SCHEME_CHAPERONE_VAL(key);
}
if (mark_set) {
Scheme_Cont_Mark_Chain *chain;
chain = ((Scheme_Cont_Mark_Set *)mark_set)->chain;
while (chain) {
if (chain->key == key)
return chain->val;
if (key_arg != key)
/*
* TODO: is this the only name that this procedure is called as
* publicly?
*/
return scheme_chaperone_do_continuation_mark("continuation-mark-set-first",
1, key_arg, chain->val);
else
return chain->val;
else if (SAME_OBJ(chain->key, prompt_tag))
break;
else
@ -7450,6 +7623,8 @@ scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, Scheme_Object *key
} else
cht = NULL;
if (key_arg != key)
val = scheme_chaperone_do_continuation_mark("continuation-mark-set-first", 1, key_arg, val);
if (!cache || !SCHEME_VECTORP(cache)) {
/* No cache so far, so map one key */
cache = scheme_make_vector(4, NULL);

5
src/racket/src/gen-jit-ts.rkt
View File

@ -60,7 +60,7 @@
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
@|return| scheme_rtcall_@|t|("[" #id "]", src_type, id, @(string-join arg-names ", ")); \
@|return| scheme_rtcall_@|t|("[" #id "]", src_type, @(string-join (cons "id" arg-names) ", ")); \
else \
@|return| id(@(string-join arg-names ", ")); \
}})
@ -196,7 +196,8 @@
sis_v
ss_i
iSp_v
sss_s))
sss_s
_v))
(with-output-to-file "jit_ts_def.c"
#:exists 'replace

17
src/racket/src/jit.c
View File

@ -2857,6 +2857,23 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
/* Key and value are on runstack */
mz_rs_sync();
if (SCHEME_TYPE(wcm->key) < _scheme_values_types_) {
/* Check whether the key is chaperoned: */
GC_CAN_IGNORE jit_insn *ref, *ref2;
mz_rs_ldxi(JIT_R0, 1);
__START_TINY_JUMPS__(1);
ref = jit_bmsi_i(jit_forward(), JIT_R0, 0x1);
ref2 = mz_bnei_t(jit_forward(), JIT_R0, scheme_chaperone_type, JIT_R1);
__END_TINY_JUMPS__(1);
(void)jit_calli(sjc.wcm_chaperone); /* adjusts values on the runstack */
__START_TINY_JUMPS__(1);
mz_patch_branch(ref);
mz_patch_branch(ref2);
__END_TINY_JUMPS__(1);
}
/* Key and value are (still) on runstack */
if (!wcm_may_replace) {
(void)jit_calli(sjc.wcm_nontail_code);
wcm_may_replace = 1;

2
src/racket/src/jit.h
View File

@ -268,7 +268,7 @@ struct scheme_jit_common_record {
void *module_run_start_code, *module_exprun_start_code, *module_start_start_code;
void *box_flonum_from_stack_code, *box_flonum_from_reg_code;
void *fl1_fail_code, *fl2rr_fail_code[2], *fl2fr_fail_code[2], *fl2rf_fail_code[2];
void *wcm_code, *wcm_nontail_code;
void *wcm_code, *wcm_nontail_code, *wcm_chaperone;
void *apply_to_list_tail_code, *apply_to_list_code, *apply_to_list_multi_ok_code;
void *eqv_code, *eqv_branch_code;
void *proc_arity_includes_code;

2
src/racket/src/jit_ts.c
View File

@ -91,6 +91,7 @@ define_ts_iS_s(scheme_checked_list_tail, FSRC_MARKS)
define_ts_iSs_s(scheme_struct_getter, FSRC_MARKS)
define_ts_iSs_s(scheme_struct_setter, FSRC_MARKS)
define_ts_iS_s(scheme_box_cas, FSRC_MARKS)
define_ts__v(chaperone_set_mark, FSRC_MARKS)
#endif
#ifdef JITCALL_TS_PROCS
@ -178,6 +179,7 @@ define_ts_s_s(scheme_box, FSRC_OTHER)
# define ts_scheme_unbox scheme_unbox
# define ts_scheme_set_box scheme_set_box
# define ts_scheme_box_cas scheme_box_cas
# define ts_chaperone_set_mark chaperone_set_mark
# define ts_scheme_vector_length scheme_vector_length
# define ts_scheme_flvector_length scheme_flvector_length
# define ts_scheme_fxvector_length scheme_fxvector_length

11
src/racket/src/jit_ts_def.c
View File

@ -39,7 +39,7 @@ static Scheme_Object* ts_ ## id() \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
return scheme_rtcall__s("[" #id "]", src_type, id, ); \
return scheme_rtcall__s("[" #id "]", src_type, id); \
else \
return id(); \
}
@ -241,3 +241,12 @@ static Scheme_Object* ts_ ## id(Scheme_Object* g59, Scheme_Object* g60, Scheme_O
else \
return id(g59, g60, g61); \
}
#define define_ts__v(id, src_type) \
static void ts_ ## id() \
XFORM_SKIP_PROC \
{ \
if (scheme_use_rtcall) \
scheme_rtcall__v("[" #id "]", src_type, id); \
else \
id(); \
}

25
src/racket/src/jit_ts_future_glue.c
View File

@ -701,4 +701,29 @@
future->retval_s = 0;
receive_special_result(future, retval, 1);
return retval;
}
void scheme_rtcall__v(const char *who, int src_type, prim__v f )
XFORM_SKIP_PROC
{
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
future_t *future;
double tm;
future = fts->thread->current_ft;
future->prim_protocol = SIG__v;
future->prim_func = f;
tm = get_future_timestamp();
future->time_of_request = tm;
future->source_of_request = who;
future->source_type = src_type;
future_do_runtimecall(fts, (void*)f, 0, 1, 0);
fts->thread = scheme_current_thread;
future = fts->thread->current_ft;
}

3
src/racket/src/jit_ts_protos.h
View File

@ -79,3 +79,6 @@ void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g221,
#define SIG_sss_s 36
typedef Scheme_Object* (*prim_sss_s)(Scheme_Object*, Scheme_Object*, Scheme_Object*);
Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g224, Scheme_Object* g225, Scheme_Object* g226);
#define SIG__v 37
typedef void (*prim__v)();
void scheme_rtcall__v(const char *who, int src_type, prim__v f );

14
src/racket/src/jit_ts_runtime_glue.c
View File

@ -374,5 +374,19 @@ case SIG_sss_s:
f(arg_s0, arg_s1, arg_s2);
future->retval_s = retval;
send_special_result(future, retval);
break;
}
case SIG__v:
{
prim__v f = (prim__v)future->prim_func;
f();
break;
}

24
src/racket/src/jitcommon.c
View File

@ -165,6 +165,15 @@ static void ts_allocate_values(int count, Scheme_Thread *p) XFORM_SKIP_PROC
# define ts_allocate_values allocate_values
#endif
static void chaperone_set_mark()
/* arguments are on runstack; result goes there, too */
{
Scheme_Object *v;
v = scheme_chaperone_do_continuation_mark("with-continuation-mark", 0, MZ_RUNSTACK[1], MZ_RUNSTACK[0]);
MZ_RUNSTACK[0] = v;
MZ_RUNSTACK[1] = SCHEME_CHAPERONE_VAL(MZ_RUNSTACK[1]);
}
#define JITCOMMON_TS_PROCS
#define JIT_APPLY_TS_PROCS
#include "jit_ts.c"
@ -2258,6 +2267,21 @@ static int common6(mz_jit_state *jitter, void *_data)
scheme_jit_register_sub_func(jitter, sjc.wcm_code, scheme_false);
}
/* wcm_chaperone */
/* key and value are on runstack and are updated there */
{
GC_CAN_IGNORE jit_insn *ref2;
sjc.wcm_chaperone = jit_get_ip().ptr;
mz_prolog(JIT_R2);
JIT_UPDATE_THREAD_RSPTR();
jit_prepare(0);
(void)mz_finish_lwe(ts_chaperone_set_mark, ref2);
mz_epilog(JIT_R2);
scheme_jit_register_sub_func(jitter, sjc.wcm_chaperone, scheme_false);
}
return 1;
}

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

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1060
#define EXPECTED_PRIM_COUNT 1064
#define EXPECTED_UNSAFE_COUNT 79
#define EXPECTED_FLFXNUM_COUNT 69
#define EXPECTED_FUTURES_COUNT 13

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

@ -885,6 +885,9 @@ typedef struct Scheme_Chaperone {
|| (SCHEME_NP_CHAPERONEP(obj) && SCHEME_BUCKTP(SCHEME_CHAPERONE_VAL(obj))))
#define SCHEME_CHAPERONE_PROMPT_TAGP(obj) (SCHEME_PROMPT_TAGP(obj) \
|| (SCHEME_NP_CHAPERONEP(obj) && SCHEME_PROMPT_TAGP(SCHEME_CHAPERONE_VAL(obj))))
#define SCHEME_CHAPERONE_CONTINUATION_MARK_KEYP(obj) (SCHEME_CONTINUATION_MARK_KEYP(obj) \
|| (SCHEME_NP_CHAPERONEP(obj) \
&& SCHEME_CONTINUATION_MARK_KEYP(SCHEME_CHAPERONE_VAL(obj))))
Scheme_Object *scheme_chaperone_vector_ref(Scheme_Object *o, int i);
void scheme_chaperone_vector_set(Scheme_Object *o, int i, Scheme_Object *v);
@ -1675,6 +1678,8 @@ Scheme_Object *scheme_apply_multi_with_dynamic_state(Scheme_Object *rator, int n
Scheme_Object *scheme_jump_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
Scheme_Object **old_runstack, int can_ec);
Scheme_Object *scheme_chaperone_do_continuation_mark(const char *name, int is_get, Scheme_Object *key, Scheme_Object *val);
/*========================================================================*/
/* semaphores and locks */
/*========================================================================*/

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.3.0.11"
#define MZSCHEME_VERSION "5.3.0.12"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 11
#define MZSCHEME_VERSION_W 12
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

199
src/racket/src/stypes.h
View File

@ -172,109 +172,110 @@ enum {
scheme_raw_pair_type, /* 152 */
scheme_prompt_type, /* 153 */
scheme_prompt_tag_type, /* 154 */
scheme_expanded_syntax_type, /* 155 */
scheme_delay_syntax_type, /* 156 */
scheme_cust_box_type, /* 157 */
scheme_resolved_module_path_type, /* 158 */
scheme_module_phase_exports_type, /* 159 */
scheme_logger_type, /* 160 */
scheme_log_reader_type, /* 161 */
scheme_free_id_info_type, /* 162 */
scheme_rib_delimiter_type, /* 163 */
scheme_noninline_proc_type, /* 164 */
scheme_prune_context_type, /* 165 */
scheme_future_type, /* 166 */
scheme_flvector_type, /* 167 */
scheme_fxvector_type, /* 168 */
scheme_place_type, /* 169 */
scheme_place_object_type, /* 170 */
scheme_place_async_channel_type, /* 171 */
scheme_place_bi_channel_type, /* 172 */
scheme_once_used_type, /* 173 */
scheme_serialized_symbol_type, /* 174 */
scheme_serialized_structure_type, /* 175 */
scheme_fsemaphore_type, /* 176 */
scheme_serialized_tcp_fd_type, /* 177 */
scheme_serialized_file_fd_type, /* 178 */
scheme_port_closed_evt_type, /* 179 */
scheme_continuation_mark_key_type, /* 155 */
scheme_expanded_syntax_type, /* 156 */
scheme_delay_syntax_type, /* 157 */
scheme_cust_box_type, /* 158 */
scheme_resolved_module_path_type, /* 159 */
scheme_module_phase_exports_type, /* 160 */
scheme_logger_type, /* 161 */
scheme_log_reader_type, /* 162 */
scheme_free_id_info_type, /* 163 */
scheme_rib_delimiter_type, /* 164 */
scheme_noninline_proc_type, /* 165 */
scheme_prune_context_type, /* 166 */
scheme_future_type, /* 167 */
scheme_flvector_type, /* 168 */
scheme_fxvector_type, /* 169 */
scheme_place_type, /* 170 */
scheme_place_object_type, /* 171 */
scheme_place_async_channel_type, /* 172 */
scheme_place_bi_channel_type, /* 173 */
scheme_once_used_type, /* 174 */
scheme_serialized_symbol_type, /* 175 */
scheme_serialized_structure_type, /* 176 */
scheme_fsemaphore_type, /* 177 */
scheme_serialized_tcp_fd_type, /* 178 */
scheme_serialized_file_fd_type, /* 179 */
scheme_port_closed_evt_type, /* 180 */
#ifdef MZTAG_REQUIRED
_scheme_last_normal_type_, /* 180 */
_scheme_last_normal_type_, /* 181 */
scheme_rt_weak_array, /* 181 */
scheme_rt_weak_array, /* 182 */
scheme_rt_comp_env, /* 182 */
scheme_rt_constant_binding, /* 183 */
scheme_rt_resolve_info, /* 184 */
scheme_rt_unresolve_info, /* 185 */
scheme_rt_optimize_info, /* 186 */
scheme_rt_compile_info, /* 187 */
scheme_rt_cont_mark, /* 188 */
scheme_rt_saved_stack, /* 189 */
scheme_rt_reply_item, /* 190 */
scheme_rt_closure_info, /* 191 */
scheme_rt_overflow, /* 192 */
scheme_rt_overflow_jmp, /* 193 */
scheme_rt_meta_cont, /* 194 */
scheme_rt_dyn_wind_cell, /* 195 */
scheme_rt_dyn_wind_info, /* 196 */
scheme_rt_dyn_wind, /* 197 */
scheme_rt_dup_check, /* 198 */
scheme_rt_thread_memory, /* 199 */
scheme_rt_input_file, /* 200 */
scheme_rt_input_fd, /* 201 */
scheme_rt_oskit_console_input, /* 202 */
scheme_rt_tested_input_file, /* 203 */
scheme_rt_tested_output_file, /* 204 */
scheme_rt_indexed_string, /* 205 */
scheme_rt_output_file, /* 206 */
scheme_rt_load_handler_data, /* 207 */
scheme_rt_pipe, /* 208 */
scheme_rt_beos_process, /* 209 */
scheme_rt_system_child, /* 210 */
scheme_rt_tcp, /* 211 */
scheme_rt_write_data, /* 212 */
scheme_rt_tcp_select_info, /* 213 */
scheme_rt_param_data, /* 214 */
scheme_rt_will, /* 215 */
scheme_rt_struct_proc_info, /* 216 */
scheme_rt_linker_name, /* 217 */
scheme_rt_param_map, /* 218 */
scheme_rt_finalization, /* 219 */
scheme_rt_finalizations, /* 220 */
scheme_rt_cpp_object, /* 221 */
scheme_rt_cpp_array_object, /* 222 */
scheme_rt_stack_object, /* 223 */
scheme_rt_preallocated_object, /* 224 */
scheme_thread_hop_type, /* 225 */
scheme_rt_srcloc, /* 226 */
scheme_rt_evt, /* 227 */
scheme_rt_syncing, /* 228 */
scheme_rt_comp_prefix, /* 229 */
scheme_rt_user_input, /* 230 */
scheme_rt_user_output, /* 231 */
scheme_rt_compact_port, /* 232 */
scheme_rt_read_special_dw, /* 233 */
scheme_rt_regwork, /* 234 */
scheme_rt_rx_lazy_string, /* 235 */
scheme_rt_buf_holder, /* 236 */
scheme_rt_parameterization, /* 237 */
scheme_rt_print_params, /* 238 */
scheme_rt_read_params, /* 239 */
scheme_rt_native_code, /* 240 */
scheme_rt_native_code_plus_case, /* 241 */
scheme_rt_jitter_data, /* 242 */
scheme_rt_module_exports, /* 243 */
scheme_rt_delay_load_info, /* 244 */
scheme_rt_marshal_info, /* 245 */
scheme_rt_unmarshal_info, /* 246 */
scheme_rt_runstack, /* 247 */
scheme_rt_sfs_info, /* 248 */
scheme_rt_validate_clearing, /* 249 */
scheme_rt_avl_node, /* 250 */
scheme_rt_lightweight_cont, /* 251 */
scheme_rt_export_info, /* 252 */
scheme_rt_cont_jmp, /* 253 */
scheme_rt_comp_env, /* 183 */
scheme_rt_constant_binding, /* 184 */
scheme_rt_resolve_info, /* 185 */
scheme_rt_unresolve_info, /* 186 */
scheme_rt_optimize_info, /* 187 */
scheme_rt_compile_info, /* 188 */
scheme_rt_cont_mark, /* 189 */
scheme_rt_saved_stack, /* 190 */
scheme_rt_reply_item, /* 191 */
scheme_rt_closure_info, /* 192 */
scheme_rt_overflow, /* 193 */
scheme_rt_overflow_jmp, /* 194 */
scheme_rt_meta_cont, /* 195 */
scheme_rt_dyn_wind_cell, /* 196 */
scheme_rt_dyn_wind_info, /* 197 */
scheme_rt_dyn_wind, /* 198 */
scheme_rt_dup_check, /* 199 */
scheme_rt_thread_memory, /* 200 */
scheme_rt_input_file, /* 201 */
scheme_rt_input_fd, /* 202 */
scheme_rt_oskit_console_input, /* 203 */
scheme_rt_tested_input_file, /* 204 */
scheme_rt_tested_output_file, /* 205 */
scheme_rt_indexed_string, /* 206 */
scheme_rt_output_file, /* 207 */
scheme_rt_load_handler_data, /* 208 */
scheme_rt_pipe, /* 209 */
scheme_rt_beos_process, /* 210 */
scheme_rt_system_child, /* 211 */
scheme_rt_tcp, /* 212 */
scheme_rt_write_data, /* 213 */
scheme_rt_tcp_select_info, /* 214 */
scheme_rt_param_data, /* 215 */
scheme_rt_will, /* 216 */
scheme_rt_struct_proc_info, /* 217 */
scheme_rt_linker_name, /* 218 */
scheme_rt_param_map, /* 219 */
scheme_rt_finalization, /* 220 */
scheme_rt_finalizations, /* 221 */
scheme_rt_cpp_object, /* 222 */
scheme_rt_cpp_array_object, /* 223 */
scheme_rt_stack_object, /* 224 */
scheme_rt_preallocated_object, /* 225 */
scheme_thread_hop_type, /* 226 */
scheme_rt_srcloc, /* 227 */
scheme_rt_evt, /* 228 */
scheme_rt_syncing, /* 229 */
scheme_rt_comp_prefix, /* 230 */
scheme_rt_user_input, /* 231 */
scheme_rt_user_output, /* 232 */
scheme_rt_compact_port, /* 233 */
scheme_rt_read_special_dw, /* 234 */
scheme_rt_regwork, /* 235 */
scheme_rt_rx_lazy_string, /* 236 */
scheme_rt_buf_holder, /* 237 */
scheme_rt_parameterization, /* 238 */
scheme_rt_print_params, /* 239 */
scheme_rt_read_params, /* 240 */
scheme_rt_native_code, /* 241 */
scheme_rt_native_code_plus_case, /* 242 */
scheme_rt_jitter_data, /* 243 */
scheme_rt_module_exports, /* 244 */
scheme_rt_delay_load_info, /* 245 */
scheme_rt_marshal_info, /* 246 */
scheme_rt_unmarshal_info, /* 247 */
scheme_rt_runstack, /* 248 */
scheme_rt_sfs_info, /* 249 */
scheme_rt_validate_clearing, /* 250 */
scheme_rt_avl_node, /* 251 */
scheme_rt_lightweight_cont, /* 252 */
scheme_rt_export_info, /* 253 */
scheme_rt_cont_jmp, /* 254 */
#endif
_scheme_last_type_

2
src/racket/src/type.c
View File

@ -274,6 +274,7 @@ scheme_init_type ()
set_name(scheme_thread_cell_values_type, "<thread-cell-values>");
set_name(scheme_prompt_tag_type, "<continuation-prompt-tag>");
set_name(scheme_continuation_mark_key_type, "<continuation-mark-key>");
set_name(scheme_string_converter_type, "<string-converter>");
@ -632,6 +633,7 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_thread_type, thread_val);
GC_REG_TRAV(scheme_prompt_type, prompt_val);
GC_REG_TRAV(scheme_prompt_tag_type, cons_cell);
GC_REG_TRAV(scheme_continuation_mark_key_type, small_object);
GC_REG_TRAV(scheme_cont_mark_set_type, cont_mark_set_val);
GC_REG_TRAV(scheme_sema_type, sema_val);
GC_REG_TRAV(scheme_channel_type, channel_val);