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; } } }