diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c index 2e6aa0784b..508412cefd 100644 --- a/src/mzscheme/gc2/newgc.c +++ b/src/mzscheme/gc2/newgc.c @@ -3044,9 +3044,12 @@ static void garbage_collect(int force_full) /* determine if this should be a full collection or not */ gc_full = force_full || !generations_available || (since_last_full > 100) || (memory_in_use > (2 * last_full_mem_use)); -/* printf("Collection #li (full = %i): %i / %i / %i / %i\n", number, */ -/* gc_full, force_full, !generations_available, */ -/* (since_last_full > 100), (memory_in_use > (2 * last_full_mem_use))); */ +#if 0 + printf("Collection %li (full = %i): %i / %i / %i / %i %ld\n", number, + gc_full, force_full, !generations_available, + (since_last_full > 100), (memory_in_use > (2 * last_full_mem_use)), + last_full_mem_use); +#endif next_gc_full = gc_full; diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index e404003b3d..59d4d5fec5 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -80,9 +80,16 @@ Bytecodes are not linear. They're actually trees of expression nodes. + Top-level variables (global or module) are referenced through the + Scheme stack, so that the variables can be "re-linked" each time a + module is instantiated. Syntax constants are similarly accessed + through the Scheme stack. The global variables and syntax objects + are sometimes called the "prefix", and scheme_push_prefix() + initializes the prefix portion of the stack. + Compilation: - Compilation works in three passes. + Compilation works in four passes. The first pass, called "compile", performs most of the work and tracks variable usage (including whether a variable is mutated or @@ -101,12 +108,10 @@ due to sharing (potentially cyclic) of closures that are "empty" but actually refer to other "empty" closures. - Top-level variables (global or module) are referenced through the - Scheme stack, so that the variables can be "re-linked" each time a - module is instantiated. Syntax constants are similarly accessed - through the Scheme stack. The global variables and syntax objects - are sometimes called the "prefix", and scheme_push_prefix() - initializes the prefix portion of the stack. + The fourth pass, "sfs", performs another liveness analysis on stack + slows and inserts operations to clear stack slots as necessary to + make execution safe for space. In particular, dead slots need to be + cleared before a non-tail call into arbitrary Scheme code. Just-in-time compilation: @@ -3574,7 +3579,7 @@ static Scheme_Object *sfs_one_branch(SFS_Info *info, int ip, n = SCHEME_INT_VAL(o); SFS_LOG(printf(" @%d %d\n", i + t_min_t, n)); if (info->max_used[i + t_min_t] < n) { - SFS_LOG(printf(" |%d %d\n", i + t_min_t, n)); + SFS_LOG(printf(" |%d %d %d\n", i + t_min_t, n, info->max_nontail)); info->max_used[i + t_min_t] = n; info->max_calls[i + t_min_t] = info->max_nontail; } @@ -3587,10 +3592,12 @@ static Scheme_Object *sfs_one_branch(SFS_Info *info, int ip, Note that it doesn't matter whether the other branch actually clears them (i.e., the relevant non-tail call might be only in this branch). */ - o = SCHEME_VEC_ELS(vec)[((1 - delta) * SFS_BRANCH_W) + 3]; + o = SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 3]; b_end = SCHEME_INT_VAL(o); + SFS_LOG(printf(" %d %d %d %d\n", nt, ip, b_end, save_nt)); if (((nt > (ip + 1)) && (nt < b_end)) /* => non-tail call in branch */ || ((ip + 1) < save_nt)) { /* => non-tail call after branches */ + SFS_LOG(printf(" other\n")); o = SCHEME_VEC_ELS(vec)[(1 - delta) * SFS_BRANCH_W]; t_min_t = SCHEME_INT_VAL(o); if (t_min_t > -1) { @@ -3608,10 +3615,10 @@ static Scheme_Object *sfs_one_branch(SFS_Info *info, int ip, pos = i + t_min_t; at_ip = info->max_used[pos]; SFS_LOG(printf(" ?%d %d %d\n", pos, n, at_ip)); + /* is last use in other branch? */ if (((!delta && (at_ip == ip)) - || (delta && (at_ip == n))) - && (at_ip < info->max_calls[pos])) { - /* Add clear */ + || (delta && (at_ip == n)))) { + /* Yes, so add clear */ SFS_LOG(printf(" !%d %d %d\n", pos, n, at_ip)); pos -= info->stackpos; clears = scheme_make_pair(scheme_make_integer(pos), @@ -3669,6 +3676,9 @@ static Scheme_Object *sfs_one_branch(SFS_Info *info, int ip, SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 3] = scheme_make_integer(info->ip); } + memset(info->max_used + info->stackpos, 0, (stackpos - info->stackpos) * sizeof(int)); + memset(info->max_calls + info->stackpos, 0, (stackpos - info->stackpos) * sizeof(int)); + info->stackpos = stackpos; return tbranch; @@ -3784,11 +3794,12 @@ static Scheme_Object *sfs_let_one(Scheme_Object *o, SFS_Info *info) { Scheme_Let_One *lo = (Scheme_Let_One *)o; Scheme_Object *body, *rhs, *vec; - int pos, save_mnt; + int pos, save_mnt, ip, et; scheme_sfs_start_sequence(info, 2, 1); scheme_sfs_push(info, 1, 1); + ip = info->ip; pos = info->stackpos; save_mnt = info->max_nontail; @@ -3822,11 +3833,35 @@ static Scheme_Object *sfs_let_one(Scheme_Object *o, SFS_Info *info) SCHEME_VEC_ELS(vec)[2] = scheme_make_integer(info->max_nontail); } else { info->max_nontail = save_mnt; + + if (info->max_used[pos] <= ip) { + /* No one is using it, so either don't push the real value, or clear it. + The optimizer normally would have converted away the binding, but + it might not because (1) it was introduced late by inlining, + or (2) the rhs expression doesn't always produce a single + value. */ + if (scheme_omittable_expr(rhs, 1, -1, 1)) { + rhs = scheme_false; + } else { + Scheme_Object *clr; + Scheme_Sequence *s; + s = malloc_sequence(2); + s->so.type = scheme_sequence_type; + s->count = 2; + clr = scheme_make_local(scheme_local_type, 0, SCHEME_LOCAL_CLEAR_ON_READ); + s->array[0] = clr; + s->array[1] = body; + body = (Scheme_Object *)s; + } + } } lo->value = rhs; lo->body = body; + et = scheme_get_eval_type(lo->value); + SCHEME_LET_EVAL_TYPE(lo) = et; + return o; } diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index 7adda10005..f655fded3d 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -1097,9 +1097,9 @@ Scheme_Object *scheme_sfs_closure(Scheme_Object *expr, SFS_Info *info, int self_ } } } - + code = scheme_sfs(data->code, info, data->max_let_depth); - + /* If any arguments go unused, and if there's a non-tail, non-immediate call in the body, then we flush the unused arguments at the start of the body. We assume that