static SCM
expand_env_lexical_gensym (SCM env, SCM name)
{
for (; scm_is_pair (env); env = CDR (env))
if (scm_is_eq (name, CAAR (env)))
return CDAR (env); /* bound */
return SCM_BOOL_F; /* free */
}
OBJECT_PTR get_continuation_for_return(OBJECT_PTR obj)
{
OBJECT_PTR rest = continuations_map;
while(rest != NIL)
{
if(CAAR(rest) == obj)
return CDAR(rest);
rest = cdr(rest);
}
return NIL;
}
static SCM
capture_flat_env (SCM lambda, SCM env)
{
int nenv;
SCM vars, link, locs;
link = CAR (env);
vars = env_link_vars (link);
nenv = scm_ilength (vars);
locs = scm_c_make_vector (nenv, SCM_BOOL_F);
for (; scm_is_pair (vars); vars = CDR (vars))
scm_c_vector_set_x (locs, --nenv, CDAR (vars));
return MAKMEMO_CAPTURE_ENV (locs, lambda);
}
Value *native_cdr(Value *args) { return CDAR(args); }
void
VM::backtrace_seek()
{
if (flags.m_backtrace != scm_false) {
backtrace_seek_make_cont(m_trace);
backtrace_seek_make_cont(m_trace_tail);
m_trace = m_trace_tail = scm_unspecified;
scm_obj_t lst = CDR(m_pc);
while (lst != scm_nil) {
scm_obj_t operands = (scm_obj_t)CDAR(lst);
int opcode = instruction_to_opcode(CAAR(lst));
switch (opcode) {
case VMOP_RET_SUBR_GLOC_OF:
case VMOP_APPLY_GLOC_OF:
fatal("%s:%u internal error: backtrace_seek()", __FILE__, __LINE__);
case VMOP_RET_SUBR:
if (PAIRP(CDR(operands))) {
backtrace_seek_make_cont(CDR(operands));
goto more_seek;
}
break;
case VMOP_APPLY_GLOC:
if (PAIRP(CDR(operands))) {
backtrace_seek_make_cont(CDR(operands));
goto more_seek;
}
break;
case VMOP_APPLY_ILOC:
if (PAIRP(CDR(operands))) {
backtrace_seek_make_cont(CDR(operands));
goto more_seek;
}
break;
case VMOP_APPLY_ILOC_LOCAL:
if (PAIRP(CDR(operands))) {
backtrace_seek_make_cont(CDR(operands));
goto more_seek;
}
break;
case VMOP_APPLY:
if (PAIRP(operands)) {
backtrace_seek_make_cont(operands);
goto more_seek;
}
break;
case VMOP_RET_CONS:
case VMOP_RET_EQP:
case VMOP_RET_NULLP:
case VMOP_RET_PAIRP:
if (PAIRP(operands)) {
backtrace_seek_make_cont(operands);
goto more_seek;
}
break;
case VMOP_EXTEND:
case VMOP_EXTEND_UNBOUND:
goto more_seek;
}
lst = CDR(lst);
}
more_seek:
scm_obj_t lst2 = m_pc;
more_more_seek:
if (lst2 == scm_nil) return;
if (!PAIRP(CAR(lst2))) return;
scm_obj_t operands = (scm_obj_t)CDAR(lst2);
int opcode = instruction_to_opcode(CAAR(lst2));
switch (opcode) {
case VMOP_SUBR_GLOC_OF:
fatal("%s:%u intern error backtrace_seek()", __FILE__, __LINE__);
case VMOP_SUBR:
if (PAIRP(CDDR(operands))) backtrace_seek_make_cont(CDDR(operands));
return;
case VMOP_EQ_ILOC:
case VMOP_LT_ILOC:
case VMOP_LE_ILOC:
case VMOP_GT_ILOC:
case VMOP_GE_ILOC:
if (PAIRP(CDR(operands))) backtrace_seek_make_cont(CDR(operands));
return;
case VMOP_EQ_N_ILOC:
case VMOP_LT_N_ILOC:
case VMOP_LE_N_ILOC:
case VMOP_GT_N_ILOC:
case VMOP_GE_N_ILOC:
case VMOP_NADD_ILOC:
case VMOP_PUSH_NADD_ILOC:
case VMOP_PUSH_SUBR:
if (PAIRP(CDDR(operands))) backtrace_seek_make_cont(CDDR(operands));
return;
case VMOP_CAR_ILOC:
case VMOP_CDR_ILOC:
case VMOP_VECTREF_ILOC:
case VMOP_PUSH_CAR_ILOC:
case VMOP_PUSH_CDR_ILOC:
case VMOP_PUSH_CADR_ILOC:
case VMOP_PUSH_CDDR_ILOC:
case VMOP_PUSH_VECTREF_ILOC:
if (PAIRP(CDR(operands))) backtrace_seek_make_cont(CDR(operands));
return;
case VMOP_CONST:
case VMOP_GLOC:
case VMOP_ILOC:
case VMOP_ILOC0:
case VMOP_ILOC1:
case VMOP_CLOSE:
case VMOP_CONST_UNSPEC:
case VMOP_PUSH_CONST:
case VMOP_PUSH_GLOC:
case VMOP_PUSH_ILOC:
case VMOP_PUSH_ILOC0:
case VMOP_PUSH_ILOC1:
case VMOP_PUSH_CLOSE:
case VMOP_PUSH:
case VMOP_CALL:
lst2 = CDR(lst2);
goto more_more_seek;
}
}
}
