static Scheme_Object *define_values_jit(Scheme_Object *data)
{
Scheme_Object *orig = SCHEME_DEFN_RHS(data), *naya;
if (SAME_TYPE(SCHEME_TYPE(orig), scheme_lambda_type)
&& (SCHEME_DEFN_VAR_COUNT(data) == 1))
naya = scheme_jit_closure(orig, SCHEME_DEFN_VAR_(data, 0));
else if (SAME_TYPE(SCHEME_TYPE(orig), scheme_inline_variant_type)
&& SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(orig)[0]), scheme_lambda_type)
&& (SCHEME_DEFN_VAR_COUNT(data) == 1)) {
naya = scheme_jit_closure(SCHEME_VEC_ELS(orig)[0], SCHEME_DEFN_VAR_(data, 0));
if (!SAME_OBJ(naya, SCHEME_DEFN_RHS(orig)))
naya = clone_inline_variant(orig, naya);
} else
naya = jit_expr(orig);
if (SAME_OBJ(naya, orig))
return data;
else {
orig = naya;
naya = scheme_clone_vector(data, 0, 1);
SCHEME_DEFN_RHS(naya) = orig;
return naya;
}
}
static Scheme_Object *define_values_jit(Scheme_Object *data)
{
Scheme_Object *orig = SCHEME_VEC_ELS(data)[0], *naya;
if (SAME_TYPE(SCHEME_TYPE(orig), scheme_unclosed_procedure_type)
&& (SCHEME_VEC_SIZE(data) == 2))
naya = scheme_jit_closure(orig, SCHEME_VEC_ELS(data)[1]);
else if (SAME_TYPE(SCHEME_TYPE(orig), scheme_inline_variant_type)
&& SAME_TYPE(SCHEME_TYPE(SCHEME_VEC_ELS(orig)[0]), scheme_unclosed_procedure_type)
&& (SCHEME_VEC_SIZE(data) == 2)) {
naya = scheme_jit_closure(SCHEME_VEC_ELS(orig)[0], SCHEME_VEC_ELS(data)[1]);
if (!SAME_OBJ(naya, SCHEME_VEC_ELS(orig)[0]))
naya = clone_inline_variant(orig, naya);
} else
naya = scheme_jit_expr(orig);
if (SAME_OBJ(naya, orig))
return data;
else {
orig = naya;
naya = scheme_clone_vector(data, 0, 1);
SCHEME_VEC_ELS(naya)[0] = orig;
return naya;
}
}
static Scheme_Object *jit_letrec(Scheme_Object *o)
{
Scheme_Letrec *lr = (Scheme_Letrec *)o, *lr2;
Scheme_Object **procs, **procs2, *v;
int i, count;
count = lr->count;
lr2 = MALLOC_ONE_TAGGED(Scheme_Letrec);
memcpy(lr2, lr, sizeof(Scheme_Letrec));
procs = lr->procs;
procs2 = MALLOC_N(Scheme_Object *, count);
lr2->procs = procs2;
for (i = 0; i < count; i++) {
v = scheme_jit_closure(procs[i], (Scheme_Object *)lr2);
procs2[i] = v;
}
v = jit_expr(lr->body);
lr2->body = v;
return (Scheme_Object *)lr2;
}
static Scheme_Object *jit_expr(Scheme_Object *expr)
{
Scheme_Type type = SCHEME_TYPE(expr);
#ifdef DO_STACK_CHECK
{
# include "mzstkchk.h"
{
Scheme_Thread *p = scheme_current_thread;
p->ku.k.p1 = (void *)expr;
return scheme_handle_stack_overflow(jit_expr_k);
}
}
#endif
switch (type) {
case scheme_application_type:
return jit_application(expr);
case scheme_application2_type:
return jit_application2(expr);
case scheme_application3_type:
return jit_application3(expr);
case scheme_sequence_type:
return jit_sequence(expr);
case scheme_branch_type:
return jit_branch(expr);
case scheme_with_cont_mark_type:
return jit_wcm(expr);
case scheme_lambda_type:
return scheme_jit_closure(expr, NULL);
case scheme_let_value_type:
return jit_let_value(expr);
case scheme_let_void_type:
return jit_let_void(expr);
case scheme_letrec_type:
return jit_letrec(expr);
case scheme_let_one_type:
return jit_let_one(expr);
case scheme_closure_type:
{
Scheme_Closure *c = (Scheme_Closure *)expr;
if (ZERO_SIZED_CLOSUREP(c)) {
/* JIT the closure body, producing a native closure: */
return scheme_jit_closure((Scheme_Object *)c->code, NULL);
} else
return expr;
}
case scheme_case_closure_type:
{
return scheme_unclose_case_lambda(expr, 1);
}
case scheme_define_values_type:
return define_values_jit(expr);
case scheme_set_bang_type:
return set_jit(expr);
case scheme_boxenv_type:
return bangboxenv_jit(expr);
case scheme_begin0_sequence_type:
return begin0_jit(expr);
case scheme_varref_form_type:
return ref_jit(expr);
case scheme_apply_values_type:
return apply_values_jit(expr);
case scheme_with_immed_mark_type:
return with_immed_mark_jit(expr);
case scheme_case_lambda_sequence_type:
return scheme_case_lambda_jit(expr);
case scheme_inline_variant_type:
return inline_variant_jit(expr);
default:
return expr;
}
}
Scheme_Object *scheme_jit_expr(Scheme_Object *expr)
{
Scheme_Type type = SCHEME_TYPE(expr);
switch (type) {
case scheme_application_type:
return jit_application(expr);
case scheme_application2_type:
return jit_application2(expr);
case scheme_application3_type:
return jit_application3(expr);
case scheme_sequence_type:
case scheme_splice_sequence_type:
return jit_sequence(expr);
case scheme_branch_type:
return jit_branch(expr);
case scheme_with_cont_mark_type:
return jit_wcm(expr);
case scheme_unclosed_procedure_type:
return scheme_jit_closure(expr, NULL);
case scheme_let_value_type:
return jit_let_value(expr);
case scheme_let_void_type:
return jit_let_void(expr);
case scheme_letrec_type:
return jit_letrec(expr);
case scheme_let_one_type:
return jit_let_one(expr);
case scheme_closure_type:
{
Scheme_Closure *c = (Scheme_Closure *)expr;
if (ZERO_SIZED_CLOSUREP(c)) {
/* JIT the closure body, producing a native closure: */
return scheme_jit_closure((Scheme_Object *)c->code, NULL);
} else
return expr;
}
case scheme_case_closure_type:
{
return scheme_unclose_case_lambda(expr, 1);
}
case scheme_define_values_type:
return define_values_jit(expr);
case scheme_define_syntaxes_type:
return define_syntaxes_jit(expr);
case scheme_begin_for_syntax_type:
return begin_for_syntax_jit(expr);
case scheme_set_bang_type:
return set_jit(expr);
case scheme_boxenv_type:
return bangboxenv_jit(expr);
case scheme_begin0_sequence_type:
return begin0_jit(expr);
case scheme_require_form_type:
return scheme_top_level_require_jit(expr);
case scheme_varref_form_type:
return ref_jit(expr);
case scheme_apply_values_type:
return apply_values_jit(expr);
case scheme_case_lambda_sequence_type:
return scheme_case_lambda_jit(expr);
case scheme_module_type:
return scheme_module_jit(expr);
case scheme_inline_variant_type:
return inline_variant_jit(expr);
default:
return expr;
}
}
