add compiled-expression-recompile

Uses an unresolver pass, which is expanded to work on more programs.
This commit is contained in:
Blake Johnson 2015-08-10 14:34:07 -06:00 committed by Matthew Flatt
parent d66da8ff3b
commit fbe8537f18
14 changed files with 2291 additions and 773 deletions

View File

@ -484,6 +484,18 @@ Like @racket[eval-syntax], but calls the current @tech{compilation
handler} in tail position with @racket[stx].}
@defproc[(compiled-expression-recompile [ce compiled-expression?]) compiled-expression?]{
Recompiles @racket[ce], effectively re-running optimization passes to
produce an equivalent compiled form with potentially different
performance characteristics.
If @racket[ce] includes module forms, then only phase-0 code in the
immediate module (not in submodules) is recompiled.
@history[#:added "6.2.900.9"]}
@defproc[(compiled-expression? [v any/c]) boolean?]{
Returns @racket[#t] if @racket[v] is a compiled form, @racket[#f]

View File

@ -73,6 +73,10 @@ define psoq
set $TL = ((Scheme_Toplevel*) ($O))
printf "scheme_toplevel_type depth=%d position=%d", $TL->depth, $TL->position
end
if ( $OT == <<scheme_local_type>> )
set $local = ((Scheme_Local *) ($O))
printf "scheme_local position=%d", $local->position
end
# if ( $OT == <<scheme_symbol_type>> )
# set $SSO = ((Scheme_Simple_Object*) ($O))
# set $index = $SSO->u.ptr_int_val.pint
@ -86,11 +90,11 @@ define psoq
printf "scheme_application_type - args %i\n", $size
set $RATOR = $AP->args[0]
indent $arg1
printf "rator="
psox $RATOR $arg1+1
printf "rator = "
psonn $RATOR
printf "\n"
set $cnt = 1
while ( $cnt < $size )
while ( $cnt <= $size )
indent $arg1
printf "rand%i = ", ($cnt - 1)
psonn $AP->args[$cnt]
@ -135,7 +139,85 @@ define psoq
psox $unclosure->code $arg1+1
set $OT = <<scheme_unclosed_procedure_type>>
end
if ( $OT == <<scheme_compiled_unclosed_procedure_type>> )
set $unclosure = ((Scheme_Closure_Data *) $O)
#set $name = $code->name
set $param_num = $unclosure->num_params
printf "scheme_compiled_unclosed_procedure_type - num_params %i\n", $param_num
psox $unclosure->code $arg1+1
end
if ( $OT == <<scheme_let_value_type>> )
set $let_value = ((Scheme_Let_Value *) $O)
set $cnt = $let_value->count
set $pos = $let_value->position
set $val = $let_value->value
set $body = $let_value->body
printf "scheme_let_value\n"
indent $arg1
printf "count = %i\n", $cnt
indent $arg1
printf "position = %i\n", $pos
psox $val $arg1+1
printf "\n"
psox $body $arg1+1
printf "\n"
end
if ( $OT == <<scheme_let_void_type>> )
set $let_void = ((Scheme_Let_Void *) $O)
set $cnt = $let_void->count
set $body = $let_void->body
printf "scheme_let_void\n"
indent $arg1
printf "count = %i\n", $cnt
indent $arg1
printf "body = "
psox $body $arg1+1
printf "\n"
end
if ( $OT == <<scheme_compiled_let_void_type>> )
set $let_header = ((Scheme_Let_Header *) $O)
set $cnt = $let_header->count
set $clauses = $let_header->num_clauses
set $body = $let_header->body
printf "scheme_let_header\n"
indent $arg1
printf "count = %i, num_clauses = %i\n", $cnt, $clauses
indent $arg1
printf "body = "
psox $body $arg1+1
printf "\n"
end
if ( $OT == <<scheme_compiled_let_value_type>> )
set $let_value = ((Scheme_Compiled_Let_Value *) $O)
set $cnt = $let_value->count
set $pos = $let_value->position
set $val = $let_value->value
set $body = $let_value->body
printf "scheme_compiled_let_value\n"
indent $arg1
printf "count = %i, position = %i\n", $cnt, $pos
indent $arg1
printf "value =\n"
psox $val $arg1+1
printf "\n"
indent $arg1
printf "body =\n"
psox $body $arg1+1
printf "\n"
end
if ( $OT == <<scheme_set_bang_type>> )
set $sb = ((Scheme_Set_Bang *) $O)
set $var = $sb->var
set $val = $sb->val
printf "scheme_set_bang\n"
indent $arg1
printf "var = "
psox $var $arg1+1
printf "\n"
printf "val = "
psox $val $arg1+1
printf "\n"
end
if ( $OT == <<scheme_sequence_type>> )
set $seq = ((Scheme_Sequence *) $O)
set $size = $seq->count
@ -151,6 +233,21 @@ define psoq
end
set $OT = 0
end
if ( $OT == <<scheme_begin0_sequence_type>> )
set $seq = ((Scheme_Sequence *) $O)
set $size = $seq->count
printf "scheme_begin0_sequence - size %i\n", $size
set $cnt = 0
while ( $cnt < $size )
indent $arg1
printf "%i - ", $cnt
psonn $seq->array[$cnt]
printf "\n"
#psox $seq->array[$cnt] $arg1+2
set $cnt++
end
set $OT = 0
end
if ( $OT == <<scheme_branch_type>>)
set $breq = ((Scheme_Branch_Rec *) $O)
printf "scheme_branch_type\n"
@ -185,6 +282,13 @@ define psoq
indent $arg1+1
printf "body %p\n", $letone->body
end
if ( $OT == <<scheme_boxenv_type>> )
set $box = ((Scheme_Simple_Object *) $O)
printf "scheme_boxenv_type\n"
psox $box->u.two_ptr_val.ptr1 $arg1+1
printf "\n"
psox $box->u.two_ptr_val.ptr2 $arg1+1
end
if ( $OT == <<scheme_closure_type>> )
printf "scheme_closure_type\n"
set $closure = ((Scheme_Closure *) $O)

View File

@ -730,23 +730,12 @@ Scheme_Object *scheme_toplevel_to_flagged_toplevel(Scheme_Object *_tl, int flags
return scheme_make_toplevel(tl->depth, tl->position, 0, flags);
}
Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
Scheme_Object *scheme_register_stx_in_comp_prefix(Scheme_Object *var, Comp_Prefix *cp)
{
Comp_Prefix *cp = env->prefix;
Scheme_Local *l;
Scheme_Object *o;
int pos;
if (rec && rec[drec].dont_mark_local_use) {
/* Make up anything; it's going to be ignored. */
l = (Scheme_Local *)scheme_malloc_atomic_tagged(sizeof(Scheme_Local));
l->iso.so.type = scheme_compiled_quote_syntax_type;
l->position = 0;
return (Scheme_Object *)l;
}
if (!cp->stxes) {
Scheme_Hash_Table *ht;
ht = scheme_make_hash_table(SCHEME_hash_ptr);
@ -767,6 +756,24 @@ Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env
return o;
}
Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec)
{
Scheme_Local *l;
Comp_Prefix *cp = env->prefix;
if (rec && rec[drec].dont_mark_local_use) {
/* Make up anything; it's going to be ignored. */
l = (Scheme_Local *)scheme_malloc_atomic_tagged(sizeof(Scheme_Local));
l->iso.so.type = scheme_compiled_quote_syntax_type;
l->position = 0;
return (Scheme_Object *)l;
}
return scheme_register_stx_in_comp_prefix(var, cp);
}
/*========================================================================*/
/* compile-time env, lookup bindings */
/*========================================================================*/

File diff suppressed because it is too large Load Diff

View File

@ -96,7 +96,9 @@
The third pass, called "optimize", performs constant propagation,
constant folding, and function inlining; this pass mutates records
produced by the "letrec_check" pass. See "optimize.c".
produced by the "letrec_check" pass. See "optimize.c". This pass
isn't optional; for example, it calculates closure information that
the third pass uses.
The fourth pass, called "resolve", finishes compilation by computing
variable offsets and indirections (often mutating the records
@ -191,7 +193,8 @@
SHARED_OK int scheme_startup_use_jit = INIT_JIT_ON;
void scheme_set_startup_use_jit(int v) { scheme_startup_use_jit = v; }
SHARED_OK static int valdiate_compile_result = 0;
SHARED_OK static int validate_compile_result = 0;
SHARED_OK static int recompile_every_compile = 0;
/* THREAD LOCAL SHARED */
THREAD_LOCAL_DECL(volatile int scheme_fuel_counter);
@ -234,6 +237,7 @@ READ_ONLY static Scheme_Object *zero_rands_ptr; /* &zero_rands_ptr is dummy rand
static Scheme_Object *eval(int argc, Scheme_Object *argv[]);
static Scheme_Object *compile(int argc, Scheme_Object *argv[]);
static Scheme_Object *compiled_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *recompile(int argc, Scheme_Object *argv[]);
static Scheme_Object *expand(int argc, Scheme_Object **argv);
static Scheme_Object *local_expand(int argc, Scheme_Object **argv);
static Scheme_Object *local_expand_expr(int argc, Scheme_Object **argv);
@ -259,6 +263,8 @@ static Scheme_Object *compile_module_constants(int argc, Scheme_Object **argv);
static Scheme_Object *use_jit(int argc, Scheme_Object **argv);
static Scheme_Object *disallow_inline(int argc, Scheme_Object **argv);
static Scheme_Object *recompile_top(Scheme_Object *top);
static Scheme_Object *_eval_compiled_multi_with_prompt(Scheme_Object *obj, Scheme_Env *env);
void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Object **rands, Scheme_Object *alt_full);
@ -351,6 +357,7 @@ scheme_init_eval (Scheme_Env *env)
GLOBAL_PRIM_W_ARITY2("eval-syntax", eval_stx, 1, 2, 0, -1, env);
GLOBAL_PRIM_W_ARITY("compile", compile, 1, 1, env);
GLOBAL_PRIM_W_ARITY("compiled-expression-recompile", recompile, 1, 1, env);
GLOBAL_PRIM_W_ARITY("compile-syntax", compile_stx, 1, 1, env);
GLOBAL_PRIM_W_ARITY("compiled-expression?", compiled_p, 1, 1, env);
GLOBAL_PRIM_W_ARITY("expand", expand, 1, 1, env);
@ -379,7 +386,24 @@ scheme_init_eval (Scheme_Env *env)
/* Enables validation of bytecode as it is generated,
to double-check that the compiler is producing
valid bytecode as it should. */
valdiate_compile_result = 1;
validate_compile_result = 1;
}
{
/* Enables re-running the optimizer N times on every compilation. */
const char *s;
s = getenv("PLT_RECOMPILE_COMPILE");
if (s) {
int i = 0;
while ((s[i] >= '0') && (s[i] <= '9')) {
recompile_every_compile = (recompile_every_compile * 10) + (s[i]-'0');
i++;
}
if (recompile_every_compile <= 0)
recompile_every_compile = 1;
else if (recompile_every_compile > 32)
recompile_every_compile = 32;
}
}
}
@ -3531,7 +3555,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
c = lv->count;
i = lv->position;
ab = SCHEME_LET_AUTOBOX(lv);
ab = SCHEME_LET_VALUE_AUTOBOX(lv);
value = lv->value;
obj = lv->body;
@ -3593,7 +3617,7 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands,
PUSH_RUNSTACK(p, RUNSTACK, c);
RUNSTACK_CHANGED();
if (SCHEME_LET_AUTOBOX(lv)) {
if (SCHEME_LET_VOID_AUTOBOX(lv)) {
GC_MAYBE_IGNORE_INTERIOR Scheme_Object **stack = RUNSTACK;
UPDATE_THREAD_RSPTR_FOR_GC();
@ -3991,6 +4015,48 @@ static int get_comp_flags(Scheme_Config *config)
return comp_flags;
}
static Scheme_Object *optimize_resolve_expr(Scheme_Object* o, Comp_Prefix *cp, Scheme_Object *src_insp_desc)
{
Optimize_Info *oi;
Resolve_Prefix *rp;
Resolve_Info *ri;
Scheme_Compilation_Top *top;
/* TODO: see if this can be moved here completely */
int comp_flags, enforce_consts, max_let_depth;
Scheme_Config *config;
config = scheme_current_config();
enforce_consts = SCHEME_TRUEP(scheme_get_param(config, MZCONFIG_COMPILE_MODULE_CONSTS));
comp_flags = get_comp_flags(config);
if (enforce_consts)
comp_flags |= COMP_ENFORCE_CONSTS;
oi = scheme_optimize_info_create(cp, 1);
scheme_optimize_info_enforce_const(oi, enforce_consts);
if (!(comp_flags & COMP_CAN_INLINE))
scheme_optimize_info_never_inline(oi);
o = scheme_optimize_expr(o, oi, 0);
rp = scheme_resolve_prefix(0, cp, src_insp_desc);
ri = scheme_resolve_info_create(rp);
scheme_resolve_info_enforce_const(ri, enforce_consts);
scheme_enable_expression_resolve_lifts(ri);
o = scheme_resolve_expr(o, ri);
max_let_depth = scheme_resolve_info_max_let_depth(ri);
o = scheme_sfs(o, NULL, max_let_depth);
o = scheme_merge_expression_resolve_lifts(o, rp, ri);
rp = scheme_remap_prefix(rp, ri);
top = MALLOC_ONE_TAGGED(Scheme_Compilation_Top);
top->iso.so.type = scheme_compilation_top_type;
top->max_let_depth = max_let_depth;
top->code = o;
top->prefix = rp;
return (Scheme_Object *)top;
}
static void *compile_k(void)
{
Scheme_Thread *p = scheme_current_thread;
@ -4189,7 +4255,14 @@ static void *compile_k(void)
top->code = o;
top->prefix = rp;
if (valdiate_compile_result) {
if (recompile_every_compile) {
int i;
for (i = recompile_every_compile; i--; ) {
top = (Scheme_Compilation_Top *)recompile_top((Scheme_Object *)top);
}
}
if (validate_compile_result) {
scheme_validate_code(NULL, top->code,
top->max_let_depth,
top->prefix->num_toplevels,
@ -4810,6 +4883,39 @@ compiled_p(int argc, Scheme_Object *argv[])
: scheme_false);
}
static Scheme_Object *recompile_top(Scheme_Object *top)
{
Comp_Prefix *cp;
Scheme_Object *code;
#if 0
printf("Resolved Code:\n%s\n\n", scheme_print_to_string(((Scheme_Compilation_Top *)top)->code, NULL));
#endif
code = scheme_unresolve_top(top, &cp);
#if 0
printf("Unresolved Prefix:\n");
printf("%s\n\n", scheme_print_to_string(cp, NULL));
printf("Unresolved Code:\n");
printf("%s\n\n", scheme_print_to_string(code, NULL));
#endif
top = optimize_resolve_expr(code, cp, ((Scheme_Compilation_Top*)top)->prefix->src_insp_desc);
return top;
}
static Scheme_Object *
recompile(int argc, Scheme_Object *argv[])
{
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_compilation_top_type)) {
scheme_wrong_contract("compiled-expression-recompile", "compiled-expression?", 0, argc, argv);
}
return recompile_top(argv[0]);
}
static Scheme_Object *expand(int argc, Scheme_Object **argv)
{
Scheme_Env *env;

View File

@ -719,7 +719,7 @@ int scheme_is_non_gc(Scheme_Object *obj, int depth)
case scheme_let_value_type:
if (depth) {
Scheme_Let_Value *lv = (Scheme_Let_Value *)obj;
if (SCHEME_LET_AUTOBOX(lv))
if (SCHEME_LET_VALUE_AUTOBOX(lv))
return 0;
return scheme_is_non_gc(lv->body, depth - 1);
}
@ -733,7 +733,7 @@ int scheme_is_non_gc(Scheme_Object *obj, int depth)
case scheme_let_void_type:
if (depth) {
Scheme_Let_Void *lv = (Scheme_Let_Void *)obj;
if (SCHEME_LET_AUTOBOX(lv))
if (SCHEME_LET_VOID_AUTOBOX(lv))
return 0;
return scheme_is_non_gc(lv->body, depth - 1);
}
@ -2721,7 +2721,7 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
case scheme_let_value_type:
{
Scheme_Let_Value *lv = (Scheme_Let_Value *)obj;
int ab = SCHEME_LET_AUTOBOX(lv), i, pos;
int ab = SCHEME_LET_VALUE_AUTOBOX(lv), i, pos;
mz_jit_unbox_state ubs;
START_JIT_DATA();
@ -2829,7 +2829,7 @@ int scheme_generate(Scheme_Object *obj, mz_jit_state *jitter, int is_tail, int w
scheme_stack_safety(jitter, c, 0);
mz_runstack_pushed(jitter, c);
if (SCHEME_LET_AUTOBOX(lv)) {
if (SCHEME_LET_VOID_AUTOBOX(lv)) {
int i;
mz_rs_sync();
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();

View File

@ -180,7 +180,7 @@ static Scheme_Object *write_let_value(Scheme_Object *obj)
return cons(scheme_make_integer(lv->count),
cons(scheme_make_integer(lv->position),
cons(SCHEME_LET_AUTOBOX(lv) ? scheme_true : scheme_false,
cons(SCHEME_LET_VALUE_AUTOBOX(lv) ? scheme_true : scheme_false,
cons(scheme_protect_quote(lv->value),
scheme_protect_quote(lv->body)))));
}
@ -199,7 +199,7 @@ static Scheme_Object *read_let_value(Scheme_Object *obj)
lv->position = SCHEME_INT_VAL(SCHEME_CAR(obj));
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return NULL;
SCHEME_LET_AUTOBOX(lv) = SCHEME_TRUEP(SCHEME_CAR(obj));
SCHEME_LET_VALUE_AUTOBOX(lv) = SCHEME_TRUEP(SCHEME_CAR(obj));
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return NULL;
lv->value = SCHEME_CAR(obj);
@ -215,7 +215,7 @@ static Scheme_Object *write_let_void(Scheme_Object *obj)
lv = (Scheme_Let_Void *)obj;
return cons(scheme_make_integer(lv->count),
cons(SCHEME_LET_AUTOBOX(lv) ? scheme_true : scheme_false,
cons(SCHEME_LET_VOID_AUTOBOX(lv) ? scheme_true : scheme_false,
scheme_protect_quote(lv->body)));
}
@ -230,7 +230,7 @@ static Scheme_Object *read_let_void(Scheme_Object *obj)
lv->count = SCHEME_INT_VAL(SCHEME_CAR(obj));
obj = SCHEME_CDR(obj);
if (!SCHEME_PAIRP(obj)) return NULL;
SCHEME_LET_AUTOBOX(lv) = SCHEME_TRUEP(SCHEME_CAR(obj));
SCHEME_LET_VOID_AUTOBOX(lv) = SCHEME_TRUEP(SCHEME_CAR(obj));
lv->body = SCHEME_CDR(obj);
return (Scheme_Object *)lv;

View File

@ -57,6 +57,12 @@ static int mark_unresolve_info_MARK(void *p, struct NewGC *gc) {
gcMARK2(i->depths, gc);
gcMARK2(i->prefix, gc);
gcMARK2(i->closures, gc);
gcMARK2(i->closures, gc);
gcMARK2(i->module, gc);
gcMARK2(i->comp_prefix, gc);
gcMARK2(i->toplevels, gc);
gcMARK2(i->definitions, gc);
gcMARK2(i->ref_args, gc);
return
gcBYTES_TO_WORDS(sizeof(Unresolve_Info));
@ -69,6 +75,12 @@ static int mark_unresolve_info_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(i->depths, gc);
gcFIXUP2(i->prefix, gc);
gcFIXUP2(i->closures, gc);
gcFIXUP2(i->closures, gc);
gcFIXUP2(i->module, gc);
gcFIXUP2(i->comp_prefix, gc);
gcFIXUP2(i->toplevels, gc);
gcFIXUP2(i->definitions, gc);
gcFIXUP2(i->ref_args, gc);
return
gcBYTES_TO_WORDS(sizeof(Unresolve_Info));

View File

@ -1309,6 +1309,12 @@ mark_unresolve_info {
gcMARK2(i->depths, gc);
gcMARK2(i->prefix, gc);
gcMARK2(i->closures, gc);
gcMARK2(i->closures, gc);
gcMARK2(i->module, gc);
gcMARK2(i->comp_prefix, gc);
gcMARK2(i->toplevels, gc);
gcMARK2(i->definitions, gc);
gcMARK2(i->ref_args, gc);
size:
gcBYTES_TO_WORDS(sizeof(Unresolve_Info));

File diff suppressed because it is too large Load Diff

View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1132
#define EXPECTED_PRIM_COUNT 1133
#define EXPECTED_UNSAFE_COUNT 106
#define EXPECTED_FLFXNUM_COUNT 69
#define EXPECTED_EXTFL_COUNT 45

View File

@ -1415,7 +1415,7 @@ typedef struct {
with a chain of Scheme_Compiled_Let_Value records as its body,
where there's one Scheme_Compiled_Let_Value for each binding
clause. A `let*' is normally expanded to nested `let's before
compilation, but the intermediate format also supposrts `let*',
compilation, but the intermediate format also supports `let*',
which is useful mostly for converting a simple enough `letrec' form
into `let*.
@ -1542,7 +1542,7 @@ typedef struct Scheme_Let_Value {
Scheme_Object *body;
} Scheme_Let_Value;
#define SCHEME_LET_AUTOBOX(lh) MZ_OPT_HASH_KEY(&lh->iso)
#define SCHEME_LET_VALUE_AUTOBOX(lv) MZ_OPT_HASH_KEY(&lv->iso)
typedef struct Scheme_Let_One {
Scheme_Inclhash_Object iso; /* keyex used for eval_type + flonum/unused (and can't be hashed) */
@ -1563,6 +1563,8 @@ typedef struct Scheme_Let_Void {
Scheme_Object *body;
} Scheme_Let_Void;
#define SCHEME_LET_VOID_AUTOBOX(lv) MZ_OPT_HASH_KEY(&lv->iso)
typedef struct Scheme_Letrec {
Scheme_Object so;
mzshort count;
@ -2949,6 +2951,10 @@ Scheme_Object *scheme_register_toplevel_in_comp_prefix(Scheme_Object *var, Comp_
void scheme_register_unbound_toplevel(Scheme_Comp_Env *env, Scheme_Object *id);
Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec);
Scheme_Object *scheme_register_stx_in_comp_prefix(Scheme_Object *var, Comp_Prefix *cp);
void scheme_register_unsafe_in_prefix(Scheme_Comp_Env *env,
Scheme_Compile_Info *rec, int drec,
Scheme_Env *menv);
void scheme_merge_undefineds(Scheme_Comp_Env *exp_env, Scheme_Comp_Env *env);
void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object *a,
@ -3024,6 +3030,7 @@ Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e);
Scheme_Object *scheme_resolve_expr(Scheme_Object *, Resolve_Info *);
Scheme_Object *scheme_resolve_list(Scheme_Object *, Resolve_Info *);
Scheme_Object *scheme_unresolve(Scheme_Object *, int argv, int *_has_cases);
Scheme_Object *scheme_unresolve_top(Scheme_Object *, Comp_Prefix **);
int scheme_check_leaf_rator(Scheme_Object *le, int *_flags);

View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "6.2.900.8"
#define MZSCHEME_VERSION "6.2.900.9"
#define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 900
#define MZSCHEME_VERSION_W 8
#define MZSCHEME_VERSION_W 9
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

View File

@ -1798,16 +1798,16 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
for (i = 0; i < c; i++, p++) {
if ((q < 0)
|| (p < 0)
|| (SCHEME_LET_AUTOBOX(lv) && ((p >= depth)
|| (SCHEME_LET_VALUE_AUTOBOX(lv) && ((p >= depth)
|| ((stack[p] != VALID_BOX)
&& (stack[p] != VALID_BOX_NOCLEAR))))
|| (!SCHEME_LET_AUTOBOX(lv) && ((p >= letlimit)
|| (!SCHEME_LET_VALUE_AUTOBOX(lv) && ((p >= letlimit)
|| !(WHEN_CAN_RESET_STACK_SLOT(stack[p] == VALID_VAL)
|| WHEN_CAN_RESET_STACK_SLOT(stack[p] == VALID_VAL_NOCLEAR)
|| (stack[p] == VALID_UNINIT)))))
scheme_ill_formed_code(port);
if (!SCHEME_LET_AUTOBOX(lv)) {
if (!SCHEME_LET_VALUE_AUTOBOX(lv)) {
if (stack[p] != VALID_VAL_NOCLEAR)
stack[p] = VALID_VAL;
}
@ -1827,7 +1827,7 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr,
if ((c < 0) || (c > delta))
scheme_ill_formed_code(port);
if (SCHEME_LET_AUTOBOX(lv)) {
if (SCHEME_LET_VOID_AUTOBOX(lv)) {
for (i = 0; i < c; i++) {
stack[--delta] = VALID_BOX;
}