static SCM create_subr (int define, const char *name, unsigned int nreq, unsigned int nopt, unsigned int rest, SCM (*fcn) (), SCM *generic_loc) { SCM ret, sname; scm_t_bits flags; scm_t_bits nfree = generic_loc ? 3 : 2; sname = scm_from_utf8_symbol (name); flags = SCM_F_PROGRAM_IS_PRIMITIVE; flags |= generic_loc ? SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC : 0; ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2); SCM_SET_CELL_WORD_1 (ret, get_subr_stub_code (nreq, nopt, rest)); SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, scm_from_pointer (fcn, NULL)); SCM_PROGRAM_FREE_VARIABLE_SET (ret, 1, sname); if (generic_loc) SCM_PROGRAM_FREE_VARIABLE_SET (ret, 2, scm_from_pointer (generic_loc, NULL)); if (define) scm_define (sname, ret); return ret; }
static SCM make_continuation_trampoline (SCM contregs) { SCM ret; scm_t_bits nfree = 1; scm_t_bits flags = SCM_F_PROGRAM_IS_CONTINUATION; ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2); SCM_SET_CELL_WORD_1 (ret, continuation_stub_code); SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, contregs); return ret; }
static SCM make_partial_continuation (SCM vm_cont) { scm_t_bits nfree = 1; scm_t_bits flags = SCM_F_PROGRAM_IS_PARTIAL_CONTINUATION; SCM ret; ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2); SCM_SET_CELL_WORD_1 (ret, compose_continuation_code); SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, vm_cont); return ret; }