Esempio n. 1
0
File: gsubr.c Progetto: teyc/guile
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;
}
Esempio n. 2
0
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;
}
Esempio n. 3
0
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;
}