void scheme_sfs_used(SFS_Info *info, int pos)
{
if (info->pass)
return;
pos += info->stackpos;
if ((pos < 0) || (pos >= info->depth)) {
scheme_signal_error("internal error: stack use out of bounds");
}
if (pos == info->tlpos)
scheme_signal_error("internal error: misuse of toplevel pointer");
SFS_LOG(printf("touch %d %d\n", pos, info->ip));
if (info->max_used[pos] >= FAR_VALUE_FOR_MAX_USED) {
info->max_used[pos] = (FAR_VALUE_FOR_MAX_USED + 1);
return;
}
if ((info->min_touch == -1)
|| (pos < info->min_touch))
info->min_touch = pos;
if (pos > info->max_touch)
info->max_touch = pos;
info->max_used[pos] = info->ip;
}
void scheme_sfs_push(SFS_Info *info, int cnt, int track)
{
info->stackpos -= cnt;
SFS_LOG(printf("push %d [%d]: %d\n", cnt, track, info->stackpos));
if (info->stackpos < 0)
scheme_signal_error("internal error: pushed too deep");
if (track) {
while (cnt--) {
scheme_sfs_used(info, cnt);
}
}
}
Scheme_Object *scheme_sfs(Scheme_Object *o, SFS_Info *info, int max_let_depth)
{
int init, i;
SFS_LOG(printf("sfs %d\n", SCHEME_TYPE(o)));
if (!info) {
info = scheme_new_sfs_info(max_let_depth);
}
info->pass = 0;
info->ip = 1;
info->abs_ip = 1;
info->saved = scheme_null;
info->min_touch = -1;
info->max_touch = -1;
info->tail_pos = 1;
init = info->stackpos;
o = scheme_sfs_expr(o, info, -1);
if (info->seqn)
scheme_signal_error("ended in the middle of an expression?");
# if MAX_SFS_CLEARING
info->max_nontail = info->ip;
info->abs_max_nontail = info->abs_ip;
# endif
for (i = info->depth; i-- > init; ) {
info->max_calls[i] = info->max_nontail;
}
{
Scheme_Object *v;
v = scheme_reverse(info->saved);
info->saved = v;
}
info->pass = 1;
info->seqn = 0;
info->ip = 1;
info->abs_ip = 1;
info->tail_pos = 1;
info->stackpos = init;
o = scheme_sfs_expr(o, info, -1);
return o;
}
static Scheme_Object *sfs_branch(Scheme_Object *o, SFS_Info *info)
{
Scheme_Branch_Rec *b;
Scheme_Object *t, *tb, *fb, *vec;
int ip, min_t, max_t;
b = (Scheme_Branch_Rec *)o;
scheme_sfs_start_sequence(info, 1, 0);
t = scheme_sfs_expr(b->test, info, -1);
ip = info->ip;
info->ip++;
/* Use ip to represent all uses in the two branches.
Use ip+1 to represent all non-tail calls in the two branches. */
min_t = info->min_touch;
max_t = info->max_touch;
SFS_LOG(printf(" after test: %d %d\n", min_t, max_t));
if (!info->pass) {
vec = scheme_make_vector(SFS_BRANCH_W * 2, NULL);
scheme_sfs_save(info, vec);
} else {
vec = scheme_sfs_next_saved(info);
}
tb = sfs_one_branch(info, ip, vec, 0, b->tbranch);
if (!info->pass) {
if ((min_t == -1)
|| ((info->min_touch > -1) && (info->min_touch < min_t)))
min_t = info->min_touch;
if (info->max_touch > max_t)
max_t = info->max_touch;
if (info->max_nontail > ip + 1)
info->max_nontail = ip + 1;
}
fb = sfs_one_branch(info, ip, vec, 1, b->fbranch);
if (!info->pass) {
if ((min_t == -1)
|| ((info->min_touch > -1) && (info->min_touch < min_t)))
min_t = info->min_touch;
if (info->max_touch > max_t)
max_t = info->max_touch;
if (info->max_nontail > ip + 1)
info->max_nontail = ip + 1;
}
SFS_LOG(printf(" done if: %d %d\n", min_t, max_t));
info->min_touch = min_t;
info->max_touch = max_t;
b->test = t;
b->tbranch = tb;
b->fbranch = fb;
return o;
}
static Scheme_Object *sfs_one_branch(SFS_Info *info, int ip,
Scheme_Object *vec, int delta,
Scheme_Object *tbranch)
{
int t_min_t, t_max_t, t_cnt, n, stackpos, i, save_nt, b_end, nt;
Scheme_Object *t_vec, *o;
Scheme_Object *clears = scheme_null;
info->min_touch = -1;
info->max_touch = -1;
save_nt = info->max_nontail;
SFS_LOG(printf("%d %d %s %d\n", info->pass, ip, (delta ? "else" : "then"), ip));
if (info->pass) {
/* Re-install max_used entries that refer to the branch */
o = SCHEME_VEC_ELS(vec)[delta * SFS_BRANCH_W];
t_min_t = SCHEME_INT_VAL(o);
o = SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 2];
nt = SCHEME_INT_VAL(o);
if (nt > info->max_nontail)
info->max_nontail = nt;
if (t_min_t > -1) {
t_vec = SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 1];
t_cnt = SCHEME_VEC_SIZE(t_vec);
for (i = 0; i < t_cnt; i++) {
o = SCHEME_VEC_ELS(t_vec)[i];
if (SCHEME_INTP(o)) {
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 %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;
}
}
}
}
/* If the other branch has last use for something not used in this
branch, and if there's a non-tail call in this branch
of later, then we'll have to start with explicit clears.
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)[(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) {
int at_ip, pos;
t_vec = SCHEME_VEC_ELS(vec)[((1 - delta) * SFS_BRANCH_W) + 1];
t_cnt = SCHEME_VEC_SIZE(t_vec);
o = SCHEME_VEC_ELS(vec)[((1 - delta) * SFS_BRANCH_W) + 2];
nt = SCHEME_INT_VAL(o);
o = SCHEME_VEC_ELS(vec)[((1 - delta) * SFS_BRANCH_W) + 3];
b_end = SCHEME_INT_VAL(o);
for (i = 0; i < t_cnt; i++) {
o = SCHEME_VEC_ELS(t_vec)[i];
if (SCHEME_INTP(o)) {
n = SCHEME_INT_VAL(o);
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)))) {
/* 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),
clears);
}
}
}
}
}
}
stackpos = info->stackpos;
tbranch = scheme_sfs_expr(tbranch, info, -1);
if (info->pass)
info->max_nontail = save_nt;
# if MAX_SFS_CLEARING
else
info->max_nontail = info->ip;
# endif
tbranch = scheme_sfs_add_clears(tbranch, clears, 1);
if (!info->pass) {
t_min_t = info->min_touch;
t_max_t = info->max_touch;
if (t_min_t < stackpos)
t_min_t = stackpos;
if (t_max_t < stackpos)
t_max_t = -1;
SFS_LOG(printf("%d %s %d [%d,%d] /%d\n", info->pass, (delta ? "else" : "then"), ip,
t_min_t, t_max_t, stackpos));
if (t_max_t < 0) {
t_min_t = -1;
t_vec = scheme_false;
} else {
t_cnt = t_max_t - t_min_t + 1;
t_vec = scheme_make_vector(t_cnt, NULL);
for (i = 0; i < t_cnt; i++) {
n = info->max_used[i + t_min_t];
SFS_LOG(printf("%d %s %d %d -> %d/%d\n", info->pass, (delta ? "else" : "then"), ip,
i + t_min_t, n, info->max_calls[i+ t_min_t]));
if (n > ip) {
SCHEME_VEC_ELS(t_vec)[i] = scheme_make_integer(n);
info->max_used[i + t_min_t] = ip;
} else {
SCHEME_VEC_ELS(t_vec)[i] = scheme_false;
}
}
}
SCHEME_VEC_ELS(vec)[delta * SFS_BRANCH_W] = scheme_make_integer(t_min_t);
SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 1] = t_vec;
SCHEME_VEC_ELS(vec)[(delta * SFS_BRANCH_W) + 2] = scheme_make_integer(info->max_nontail);
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;
}
