static Scheme_Object *chaperone_vector_ref_overflow(Scheme_Object *o, int i) { Scheme_Thread *p = scheme_current_thread; p->ku.k.p1 = (void *)o; p->ku.k.i1 = i; return scheme_handle_stack_overflow(chaperone_vector_ref_k); }
static int is_equal_overflow(Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql) { Scheme_Thread *p = scheme_current_thread; Equal_Info *eql2; Scheme_Object *v; eql2 = (Equal_Info *)scheme_malloc(sizeof(Equal_Info)); memcpy(eql2, eql, sizeof(Equal_Info)); p->ku.k.p1 = (void *)obj1; p->ku.k.p2 = (void *)obj2; p->ku.k.p3 = (void *)eql2; v = scheme_handle_stack_overflow(equal_k); memcpy(eql, eql2, sizeof(Equal_Info)); return SCHEME_TRUEP(v); }
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; #ifdef DO_STACK_CHECK { # include "mzstkchk.h" { Scheme_Thread *p = scheme_current_thread; p->ku.k.p1 = (void *)expr; p->ku.k.p2 = (void *)info; p->ku.k.i1 = closure_self_pos; return scheme_handle_stack_overflow(sfs_expr_k); } } #endif seqn = info->seqn; stackpos = info->stackpos; tp = info->tail_pos; if (seqn) { info->seqn = 0; info->tail_pos = 0; } info->ip++; info->abs_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_TYPE(expr)) { 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_lambda_type: expr = sfs_lambda(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_lambda((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_Lambda *)seq->array[0]; seq->array[0] = expr; expr = code; } else { c->code = (Scheme_Lambda *)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_with_immed_mark_type: expr = with_immed_mark_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; }
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; } }