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_sfs_expr(Scheme_Object *expr, SFS_Info *info, int closure_self_pos)
/* closure_self_pos == -2 => immediately in sequence */
{
Scheme_Type type = SCHEME_TYPE(expr);
int seqn, stackpos, tp;
seqn = info->seqn;
stackpos = info->stackpos;
tp = info->tail_pos;
if (seqn) {
info->seqn = 0;
info->tail_pos = 0;
}
info->ip++;
switch (type) {
case scheme_local_type:
case scheme_local_unbox_type:
if (!info->pass)
scheme_sfs_used(info, SCHEME_LOCAL_POS(expr));
else if (SCHEME_GET_LOCAL_FLAGS(expr) != SCHEME_LOCAL_FLONUM) {
int pos, at_ip;
pos = SCHEME_LOCAL_POS(expr);
at_ip = info->max_used[info->stackpos + pos];
if (at_ip < info->max_calls[info->stackpos + pos]) {
if (at_ip == info->ip) {
/* Clear on read: */
expr = scheme_make_local(type, pos, SCHEME_LOCAL_CLEAR_ON_READ);
} else {
/* Someone else clears it: */
expr = scheme_make_local(type, pos, SCHEME_LOCAL_OTHER_CLEARS);
}
} else {
# if MAX_SFS_CLEARING
scheme_signal_error("should have been cleared somewhere");
# endif
}
}
break;
case scheme_application_type:
expr = sfs_application(expr, info);
break;
case scheme_application2_type:
expr = sfs_application2(expr, info);
break;
case scheme_application3_type:
expr = sfs_application3(expr, info);
break;
case scheme_sequence_type:
expr = sfs_sequence(expr, info, closure_self_pos != -2);
break;
case scheme_splice_sequence_type:
expr = sfs_sequence(expr, info, 0);
break;
case scheme_branch_type:
expr = sfs_branch(expr, info);
break;
case scheme_with_cont_mark_type:
expr = sfs_wcm(expr, info);
break;
case scheme_unclosed_procedure_type:
expr = sfs_closure(expr, info, closure_self_pos);
break;
case scheme_let_value_type:
expr = sfs_let_value(expr, info);
break;
case scheme_let_void_type:
expr = sfs_let_void(expr, info);
break;
case scheme_letrec_type:
expr = sfs_letrec(expr, info);
break;
case scheme_let_one_type:
expr = sfs_let_one(expr, info);
break;
case scheme_closure_type:
{
Scheme_Closure *c = (Scheme_Closure *)expr;
if (ZERO_SIZED_CLOSUREP(c)) {
Scheme_Object *code;
code = sfs_closure((Scheme_Object *)c->code, info, closure_self_pos);
if (SAME_TYPE(SCHEME_TYPE(code), scheme_begin0_sequence_type)) {
Scheme_Sequence *seq = (Scheme_Sequence *)code;
c->code = (Scheme_Closure_Data *)seq->array[0];
seq->array[0] = expr;
expr = code;
} else {
c->code = (Scheme_Closure_Data *)code;
}
}
}
break;
case scheme_toplevel_type:
{
int c = SCHEME_TOPLEVEL_DEPTH(expr);
if (info->stackpos + c != info->tlpos)
scheme_signal_error("toplevel access not at expected place");
}
break;
case scheme_case_closure_type:
{
/* FIXME: maybe need to handle eagerly created closure */
}
break;
case scheme_define_values_type:
expr = define_values_sfs(expr, info);
break;
case scheme_define_syntaxes_type:
expr = define_syntaxes_sfs(expr, info);
break;
case scheme_begin_for_syntax_type:
expr = begin_for_syntax_sfs(expr, info);
break;
case scheme_set_bang_type:
expr = set_sfs(expr, info);
break;
case scheme_boxenv_type:
expr = bangboxenv_sfs(expr, info);
break;
case scheme_begin0_sequence_type:
expr = begin0_sfs(expr, info);
break;
case scheme_require_form_type:
expr = top_level_require_sfs(expr, info);
break;
case scheme_varref_form_type:
expr = ref_sfs(expr, info);
break;
case scheme_apply_values_type:
expr = apply_values_sfs(expr, info);
break;
case scheme_case_lambda_sequence_type:
expr = case_lambda_sfs(expr, info);
break;
case scheme_module_type:
expr = module_sfs(expr, info);
break;
case scheme_inline_variant_type:
expr = inline_variant_sfs(expr, info);
break;
default:
break;
}
info->ip++;
if (seqn) {
info->seqn = seqn - 1;
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;
info->tail_pos = tp;
}
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;
}
}
