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;
}
static Scheme_Object *bangboxenv_jit(Scheme_Object *data)
{
Scheme_Object *orig, *naya, *new_data;
orig = SCHEME_PTR2_VAL(data);
naya = jit_expr(orig);
if (SAME_OBJ(naya, orig))
return data;
else {
new_data = scheme_alloc_object();
new_data->type = scheme_boxenv_type;
SCHEME_PTR1_VAL(new_data) = SCHEME_PTR1_VAL(data);
SCHEME_PTR2_VAL(new_data) = naya;
return new_data;
}
}
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 *apply_values_jit(Scheme_Object *data)
{
Scheme_Object *f, *e;
f = jit_expr(SCHEME_PTR1_VAL(data));
e = jit_expr(SCHEME_PTR2_VAL(data));
if (SAME_OBJ(f, SCHEME_PTR1_VAL(data))
&& SAME_OBJ(e, SCHEME_PTR2_VAL(data)))
return data;
else {
data = scheme_alloc_object();
data->type = scheme_apply_values_type;
SCHEME_PTR1_VAL(data) = f;
SCHEME_PTR2_VAL(data) = e;
return data;
}
}
Scheme_Object *scheme_make_cptr(void *cptr, Scheme_Object *typetag)
{
Scheme_Object *o;
o = scheme_alloc_object();
o->type = scheme_cpointer_type;
SCHEME_PTR1_VAL(o) = cptr;
SCHEME_PTR2_VAL(o) = (void *)typetag;
return o;
}
Scheme_Object *read_boxenv(Scheme_Object *o)
{
Scheme_Object *data;
if (!SCHEME_PAIRP(o)) return NULL;
data = scheme_alloc_object();
data->type = scheme_boxenv_type;
SCHEME_PTR1_VAL(data) = SCHEME_CAR(o);
SCHEME_PTR2_VAL(data) = SCHEME_CDR(o);
return data;
}
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;
}
}
Scheme_Object *write_boxenv(Scheme_Object *o)
{
return scheme_make_pair(SCHEME_PTR1_VAL(o), SCHEME_PTR2_VAL(o));
}
Scheme_Object *write_apply_values(Scheme_Object *o)
{
return scheme_make_pair(scheme_protect_quote(SCHEME_PTR1_VAL(o)),
scheme_protect_quote(SCHEME_PTR2_VAL(o)));
}