static Scheme_Object *with_immed_mark_sfs(Scheme_Object *o, SFS_Info *info)
{
Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)o;
Scheme_Object *k, *v, *b, *vec;
int pos, save_mnt;
scheme_sfs_start_sequence(info, 3, 1);
k = scheme_sfs_expr(wcm->key, info, -1);
v = scheme_sfs_expr(wcm->val, info, -1);
scheme_sfs_push(info, 1, 1);
pos = info->stackpos;
save_mnt = info->max_nontail;
if (!info->pass) {
vec = scheme_make_vector(3, NULL);
scheme_sfs_save(info, vec);
} else {
vec = scheme_sfs_next_saved(info);
if (SCHEME_VEC_SIZE(vec) != 3)
scheme_signal_error("internal error: bad vector length");
info->max_used[pos] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[0]);
info->max_calls[pos] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[1]);
info->max_nontail = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[2]);
}
b = scheme_sfs_expr(wcm->body, info, -1);
wcm->key = k;
wcm->val = v;
wcm->body = b;
# if MAX_SFS_CLEARING
if (!info->pass)
info->max_nontail = info->ip;
# endif
if (!info->pass) {
int n;
info->max_calls[pos] = info->max_nontail;
n = info->max_used[pos];
SCHEME_VEC_ELS(vec)[0] = scheme_make_integer(n);
n = info->max_calls[pos];
SCHEME_VEC_ELS(vec)[1] = scheme_make_integer(n);
SCHEME_VEC_ELS(vec)[2] = scheme_make_integer(info->max_nontail);
} else {
info->max_nontail = save_mnt;
}
return o;
}
static Scheme_Object *
ref_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Object *a_naya;
Scheme_Object *b_naya;
scheme_sfs_start_sequence(info, 1, 0);
a_naya = scheme_sfs_expr(SCHEME_PTR1_VAL(data), info, -1);
b_naya = scheme_sfs_expr(SCHEME_PTR2_VAL(data), info, -1);
SCHEME_PTR1_VAL(data) = a_naya;
SCHEME_PTR2_VAL(data) = b_naya;
return data;
}
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_wcm(Scheme_Object *o, SFS_Info *info)
{
Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)o;
Scheme_Object *k, *v, *b;
scheme_sfs_start_sequence(info, 3, 1);
k = scheme_sfs_expr(wcm->key, info, -1);
v = scheme_sfs_expr(wcm->val, info, -1);
b = scheme_sfs_expr(wcm->body, info, -1);
wcm->key = k;
wcm->val = v;
wcm->body = b;
return o;
}
static Scheme_Object *
apply_values_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Object *f, *e;
f = SCHEME_PTR1_VAL(data);
e = SCHEME_PTR2_VAL(data);
scheme_sfs_start_sequence(info, 2, 0);
f = scheme_sfs_expr(f, info, -1);
e = scheme_sfs_expr(e, info, -1);
SCHEME_PTR1_VAL(data) = f;
SCHEME_PTR2_VAL(data) = e;
return data;
}
static Scheme_Object *
define_values_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Object *e;
scheme_sfs_start_sequence(info, 1, 0);
e = scheme_sfs_expr(SCHEME_VEC_ELS(data)[0], info, -1);
SCHEME_VEC_ELS(data)[0] = e;
return data;
}
static Scheme_Object *
inline_variant_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Object *e;
scheme_sfs_start_sequence(info, 1, 0);
e = scheme_sfs_expr(SCHEME_VEC_ELS(data)[0], info, -1);
SCHEME_VEC_ELS(data)[0] = e;
/* we don't bother with inlinable variant, since it isn't called directly */
return data;
}
static Scheme_Object *
set_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Set_Bang *sb = (Scheme_Set_Bang *)data;
Scheme_Object *var, *val;
var = sb->var;
val = sb->val;
scheme_sfs_start_sequence(info, 2, 0);
val = scheme_sfs_expr(val, info, -1);
var = scheme_sfs_expr(var, info, -1);
sb->var = var;
sb->val = val;
return (Scheme_Object *)sb;
}
static Scheme_Object *sfs_expr_k(void)
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Object *e = (Scheme_Object *)p->ku.k.p1;
SFS_Info *info = (SFS_Info *)p->ku.k.p2;
p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL;
return scheme_sfs_expr(e, info, p->ku.k.i1);
}
static Scheme_Object *sfs_application2(Scheme_Object *o, SFS_Info *info)
{
Scheme_App2_Rec *app;
Scheme_Object *nrator, *nrand;
app = (Scheme_App2_Rec *)o;
scheme_sfs_start_sequence(info, 2, 0);
scheme_sfs_push(info, 1, 0);
nrator = scheme_sfs_expr(app->rator, info, -1);
nrand = scheme_sfs_expr(app->rand, info, -1);
app->rator = nrator;
app->rand = nrand;
sfs_note_app(info, app->rator);
scheme_reset_app2_eval_type(app);
return o;
}
static Scheme_Object *sfs_let_value(Scheme_Object *o, SFS_Info *info)
{
Scheme_Let_Value *lv = (Scheme_Let_Value *)o;
Scheme_Object *body, *rhs, *clears = scheme_null;
int i, pos;
scheme_sfs_start_sequence(info, 2, 1);
rhs = scheme_sfs_expr(lv->value, info, -1);
if (!info->pass
|| (info->ip < info->max_nontail)) {
for (i = 0; i < lv->count; i++) {
pos = lv->position + i;
if (!info->pass)
scheme_sfs_used(info, pos);
else {
int spos;
spos = pos + info->stackpos;
if ((info->max_used[spos] == info->ip)
&& (info->max_calls[spos] > info->ip)) {
/* No one is using the id after we set it.
We still need to set it, in case it's boxed and shared,
but then remove the binding or box. */
clears = scheme_make_pair(scheme_make_integer(pos),
clears);
}
}
}
}
body = scheme_sfs_expr(lv->body, info, -1);
body = scheme_sfs_add_clears(body, clears, 1);
lv->value = rhs;
lv->body = body;
return o;
}
static Scheme_Object *sfs_letrec(Scheme_Object *o, SFS_Info *info)
{
Scheme_Letrec *lr = (Scheme_Letrec *)o;
Scheme_Object **procs, *v, *clears = scheme_null;
int i, count;
count = lr->count;
scheme_sfs_start_sequence(info, count + 1, 1);
procs = lr->procs;
for (i = 0; i < count; i++) {
v = scheme_sfs_expr(procs[i], info, i);
if (SAME_TYPE(SCHEME_TYPE(v), scheme_begin0_sequence_type)) {
/* Some clearing actions were added to the closure.
Lift them out. */
int j;
Scheme_Sequence *cseq = (Scheme_Sequence *)v;
for (j = 1; j < cseq->count; j++) {
int pos;
pos = SCHEME_LOCAL_POS(cseq->array[j]);
clears = scheme_make_pair(scheme_make_integer(pos), clears);
}
v = cseq->array[0];
}
procs[i] = v;
}
v = scheme_sfs_expr(lr->body, info, -1);
v = scheme_sfs_add_clears(v, clears, 1);
lr->body = v;
return o;
}
static Scheme_Object *sfs_application3(Scheme_Object *o, SFS_Info *info)
{
Scheme_App3_Rec *app;
Scheme_Object *nrator, *nrand1, *nrand2;
app = (Scheme_App3_Rec *)o;
scheme_sfs_start_sequence(info, 3, 0);
scheme_sfs_push(info, 2, 0);
nrator = scheme_sfs_expr(app->rator, info, -1);
nrand1 = scheme_sfs_expr(app->rand1, info, -1);
nrand2 = scheme_sfs_expr(app->rand2, info, -1);
app->rator = nrator;
app->rand1 = nrand1;
app->rand2 = nrand2;
sfs_note_app(info, app->rator);
scheme_reset_app3_eval_type(app);
return o;
}
static Scheme_Object *sfs_let_void(Scheme_Object *o, SFS_Info *info)
{
Scheme_Let_Void *lv = (Scheme_Let_Void *)o;
Scheme_Object *body;
int i, pos, save_mnt;
Scheme_Object *vec;
scheme_sfs_push(info, lv->count, 1);
pos = info->stackpos;
save_mnt = info->max_nontail;
if (!info->pass) {
vec = scheme_make_vector(lv->count + 1, NULL);
scheme_sfs_save(info, vec);
} else {
vec = scheme_sfs_next_saved(info);
if (!SCHEME_VECTORP(vec))
scheme_signal_error("internal error: not a vector");
for (i = 0; i < lv->count; i++) {
info->max_used[pos + i] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[i]);
info->max_calls[pos + i] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[lv->count]);
}
info->max_nontail = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[lv->count]);
}
body = scheme_sfs_expr(lv->body, info, -1);
# if MAX_SFS_CLEARING
if (!info->pass)
info->max_nontail = info->ip;
# endif
if (!info->pass) {
int n;
SCHEME_VEC_ELS(vec)[lv->count] = scheme_make_integer(info->max_nontail);
for (i = 0; i < lv->count; i++) {
n = info->max_used[pos + i];
SCHEME_VEC_ELS(vec)[i] = scheme_make_integer(n);
}
} else {
info->max_nontail = save_mnt;
}
lv->body = body;
return o;
}
static Scheme_Object *
module_sfs(Scheme_Object *data, SFS_Info *old_info)
{
Scheme_Module *m = (Scheme_Module *)data;
Scheme_Object *e, *ex;
SFS_Info *info;
int i, j, cnt, let_depth;
if (!old_info->for_mod) {
if (old_info->pass)
return data;
info = scheme_new_sfs_info(m->max_let_depth);
info->for_mod = 1;
scheme_sfs(data, info, m->max_let_depth);
return data;
}
info = old_info;
cnt = SCHEME_VEC_SIZE(m->bodies[0]);
scheme_sfs_start_sequence(info, cnt, 0);
for (i = 0; i < cnt; i++) {
e = scheme_sfs_expr(SCHEME_VEC_ELS(m->bodies[0])[i], info, -1);
SCHEME_VEC_ELS(m->bodies[0])[i] = e;
}
if (!info->pass) {
for (j = m->num_phases; j-- > 1; ) {
cnt = SCHEME_VEC_SIZE(m->bodies[j]);
for (i = 0; i < cnt; i++) {
e = SCHEME_VEC_ELS(m->bodies[j])[i];
let_depth = SCHEME_INT_VAL(SCHEME_VEC_ELS(e)[2]);
ex = SCHEME_VEC_ELS(e)[1];
info = scheme_new_sfs_info(let_depth);
ex = scheme_sfs(ex, info, let_depth);
SCHEME_VEC_ELS(e)[1] = ex;
}
}
}
return data;
}
static Scheme_Object *
begin0_sfs(Scheme_Object *obj, SFS_Info *info)
{
int i, cnt;
cnt = ((Scheme_Sequence *)obj)->count;
scheme_sfs_start_sequence(info, cnt, 0);
for (i = 0; i < cnt; i++) {
Scheme_Object *le;
le = scheme_sfs_expr(((Scheme_Sequence *)obj)->array[i], info, -1);
((Scheme_Sequence *)obj)->array[i] = le;
}
return obj;
}
static Scheme_Object *
case_lambda_sfs(Scheme_Object *expr, SFS_Info *info)
{
Scheme_Case_Lambda *seq = (Scheme_Case_Lambda *)expr;
Scheme_Object *le, *clears = scheme_null;
int i;
scheme_sfs_start_sequence(info, seq->count, 0);
for (i = 0; i < seq->count; i++) {
le = seq->array[i];
le = scheme_sfs_expr(le, info, -1);
if (SAME_TYPE(SCHEME_TYPE(le), scheme_begin0_sequence_type)) {
/* Some clearing actions were added to the closure.
Lift them out. */
int j;
Scheme_Sequence *cseq = (Scheme_Sequence *)le;
if (!cseq->count)
scheme_signal_error("internal error: empty sequence");
for (j = 1; j < cseq->count; j++) {
int pos;
pos = SCHEME_LOCAL_POS(cseq->array[j]);
clears = scheme_make_pair(scheme_make_integer(pos), clears);
}
le = cseq->array[0];
}
if (!SAME_TYPE(SCHEME_TYPE(le), scheme_unclosed_procedure_type)
&& !SAME_TYPE(SCHEME_TYPE(le), scheme_closure_type)) {
scheme_signal_error("internal error: not a lambda for case-lambda: %d",
SCHEME_TYPE(le));
}
seq->array[i] = le;
}
if (!SCHEME_NULLP(clears)) {
return scheme_sfs_add_clears(expr, clears, 0);
} else
return expr;
}
static Scheme_Object *sfs_sequence(Scheme_Object *o, SFS_Info *info, int can_flatten)
{
Scheme_Object *orig, *naya;
Scheme_Sequence *seq;
int i, n;
seq = (Scheme_Sequence *)o;
n = seq->count;
scheme_sfs_start_sequence(info, n, 1);
for (i = 0; i < n; i++) {
orig = seq->array[i];
naya = scheme_sfs_expr(orig, info, -2);
seq->array[i] = naya;
}
if (can_flatten && info->pass)
o = flatten_sequence(o);
return o;
}
static Scheme_Object *bangboxenv_sfs(Scheme_Object *data, SFS_Info *info)
{
Scheme_Object *e;
int spos, drop;
spos = SCHEME_INT_VAL(SCHEME_PTR1_VAL(data)) + info->stackpos;
if (info->pass
&& (info->max_used[spos] < info->ip))
/* Not used, so don't bother boxing. In fact, the original value
might be cleared already, so we wan't legally box anymore. */
drop = 1;
else
drop = 0;
e = scheme_sfs_expr(SCHEME_PTR2_VAL(data), info, -1);
if (drop)
return e;
else {
SCHEME_PTR2_VAL(data) = e;
return data;
}
}
static Scheme_Object *sfs_application(Scheme_Object *o, SFS_Info *info)
{
Scheme_Object *orig, *naya = NULL;
Scheme_App_Rec *app;
int i, n;
app = (Scheme_App_Rec *)o;
n = app->num_args + 1;
scheme_sfs_start_sequence(info, n, 0);
scheme_sfs_push(info, n-1, 0);
for (i = 0; i < n; i++) {
orig = app->args[i];
naya = scheme_sfs_expr(orig, info, -1);
app->args[i] = naya;
}
sfs_note_app(info, app->args[0]);
scheme_finish_application(app);
return o;
}
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, ip, et;
int unused = 0;
scheme_sfs_start_sequence(info, 2, 1);
scheme_sfs_push(info, 1, 1);
ip = info->ip;
pos = info->stackpos;
save_mnt = info->max_nontail;
if (!info->pass) {
vec = scheme_make_vector(3, NULL);
scheme_sfs_save(info, vec);
} else {
vec = scheme_sfs_next_saved(info);
if (SCHEME_VEC_SIZE(vec) != 3)
scheme_signal_error("internal error: bad vector length");
info->max_used[pos] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[0]);
info->max_calls[pos] = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[1]);
info->max_nontail = SCHEME_INT_VAL(SCHEME_VEC_ELS(vec)[2]);
}
rhs = scheme_sfs_expr(lo->value, info, -1);
body = scheme_sfs_expr(lo->body, info, -1);
# if MAX_SFS_CLEARING
if (!info->pass)
info->max_nontail = info->ip;
# endif
if (!info->pass) {
int n;
info->max_calls[pos] = info->max_nontail;
n = info->max_used[pos];
SCHEME_VEC_ELS(vec)[0] = scheme_make_integer(n);
n = info->max_calls[pos];
SCHEME_VEC_ELS(vec)[1] = scheme_make_integer(n);
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 don't actually push the value at run time
(but keep the check that the result is single-valued).
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, NULL, -1)) {
rhs = scheme_false;
} else if ((ip < info->max_calls[pos])
&& SAME_TYPE(SCHEME_TYPE(rhs), scheme_toplevel_type)) {
/* Unusual case: we can't just drop the global-variable access,
because it might be undefined, but we don't need the value,
and we want to avoid an SFS clear in the interpreter loop.
So, bind #f and then access in the global in a `begin'. */
Scheme_Sequence *s;
s = scheme_malloc_sequence(2);
s->so.type = scheme_sequence_type;
s->count = 2;
s->array[0] = rhs;
s->array[1] = body;
body = (Scheme_Object *)s;
rhs = scheme_false;
}
unused = 1;
}
}
lo->value = rhs;
lo->body = body;
et = scheme_get_eval_type(lo->value);
SCHEME_LET_EVAL_TYPE(lo) = (et
| (unused ? 0 : (SCHEME_LET_EVAL_TYPE(lo) & LET_ONE_FLONUM))
| (unused ? LET_ONE_UNUSED : 0));
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;
}
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;
}
