skint/i.c

/* i.c -- instructions */

#include "n.h"
#include "i.h"

/* imports */
extern obj cx__2Aglobals_2A;
extern obj cx__2Atransformers_2A;
extern obj cx__2Adynamic_2Dstate_2A;
extern obj cx_continuation_2Dadapter_2Dcode;
extern obj cx_callmv_2Dadapter_2Dclosure;
extern obj cx__2Acurrent_2Dinput_2A;
extern obj cx__2Acurrent_2Doutput_2A;
extern obj cx__2Acurrent_2Derror_2A;

//#define istagged(o, t) istagged_inlined(o, t) 

/* forwards */
static struct intgtab_entry *lookup_integrable(int sym);
static int isintegrable(obj x);
static struct intgtab_entry *integrabledata(obj x);
static obj mkintegrable(struct intgtab_entry *);
static int integrable_type(struct intgtab_entry *pi);
static const char *integrable_global(struct intgtab_entry *pi);
static const char *integrable_code(struct intgtab_entry *pi, int n);
static obj *rds_intgtab(obj *r, obj *sp, obj *hp);
static obj *rds_stox(obj *r, obj *sp, obj *hp);
static obj *rds_stoc(obj *r, obj *sp, obj *hp);
static obj *init_modules(obj *r, obj *sp, obj *hp);

/* platform-dependent optimizations */
#if defined(__clang__)
#define unlikely(x) __builtin_expect(x, 0)
#define likely(x)   __builtin_expect(x, 1)
#if __clang_major__ >= 13
#define VM_AC_IN_REG
#define outofline   __attribute__((noinline))
#define VM_MUSTTAIL_GUARANTEE
#define musttail    __attribute__((musttail))
#define regcall     __regcall        
#define noalias     restrict
#else
#define outofline
#define musttail    
#define regcall
#define noalias
#endif
/* #pragma GCC optimize ("align-functions=16") */
#define nochecks    __attribute__((no_stack_protector, aligned(8)))
/* __attribute__((nocf_check)) */
#define VM_INS_CODE_ALIGNED
#else
#define unlikely(x) (x)
#define likely(x)   (x)
#define outofline
#define musttail
#define regcall
#define noalias
#define nochecks
#endif

/* copying objects */
#ifndef OBJCOPY_LOOP
#define objcpy(dst, src, cnt) \
  memcpy((dst), (src), (cnt)*sizeof(obj))  
#define objmove_left(dst, src, cnt) \
  memmove((dst), (src), (cnt)*sizeof(obj))  
#define objmove(dst, src, cnt) \
  memmove((dst), (src), (cnt)*sizeof(obj))  
#else
#define objcpy(dst, src, cnt) \
  do { obj *noalias dp__ = (dst), *noalias sp__ = (src); int n__ = (cnt); \
       while (n__-- > 0) *dp__++ = *sp__++; } while(0)
#define objmove_left(dst, src, cnt) \
  do { int n__ = (cnt); obj *dp__ = (dst), *sp__ = (src); \
       while (n__-- > 0) *dp__++ = *sp__++; } while(0)
#define objmove_right(dst, src, cnt) \
  do { int n__ = (cnt); obj *dp__ = (dst)+n__, *sp__ = (src)+n__; \
       while (n__-- > 0) *--dp__ = *--sp__; } while(0)
#define objmove(dst, src, cnt) \
  do { int n__ = (cnt); obj *dp__ = (dst), *sp__ = (src); \
       if (dp__ > sp__) { dp__ += n__, sp__ += n; while (n__-- > 0) *--dp__ = *--sp__; } \
       else if (dp__ < sp__) while (n__-- > 0) *dp__++ = *sp__++; } while(0)
#endif


#ifdef VM_INS_CODE_ALIGNED /* direct representation */
#define ins_from_obj(x) ((ins_t)(x))
#else /* indirect representation (alignment needed) */
#define ins_from_obj(x) (*(ins_t*)(x))
#endif

/* instruction calling convention (platform-dependent) */
#ifdef VM_AC_IN_REG
#define ILOCALS       obj ac, *r, *ip, *sp, *hp
#define IPARAMS       obj ac, obj *noalias r, obj *noalias ip, obj *noalias sp, obj *noalias hp
#define IARGS         ac, r, ip, sp, hp
#define IARGS1        ac, r, ip+1, sp, hp
#define unload_ac()   (ra = ac)
#define reload_ac()   (ac = ra)
#else
#define ILOCALS       obj *r, *ip, *sp, *hp
#define IPARAMS       obj *r, obj *noalias ip, obj *noalias sp, obj *noalias hp
#define IARGS         r, ip, sp, hp
#define IARGS1        r, ip+1, sp, hp
#define ac ra
#define unload_ac()   (0)
#define reload_ac()   (0)
#endif

/* gc-safe obj registers; some of them used for saving/restoring during gc */
#define rk   (r[0])   /* #f or any non-false value for unwindi; run result */
#define ra   (r[1])   /* shadow reg for the accumulator (argc on call) */
#define rx   (r[2])   /* next instruction (index in closure's code) */
#define rd   (r[3])   /* current closure/display (vector of [0]=code, display) */
#define rs   (r[4])   /* shadow reg for stack pointer */
#define rz   (r[5])   /* red zone for stack pointer (r + len - rsz) */

/* the rest of the register file is used as a stack */
#define VM_REGC       6      /* r[0] ... r[5] */
#define VM_STACK_LEN  256000 /* r[6] ... r[256005] */
#define VM_STACK_RSZ  256    /* red zone for overflow checks */
#define VM_STACK_GSZ  (VM_STACK_LEN-VM_STACK_RSZ)

/* faster non-debug type testing */
#ifdef NDEBUG /* quick */
static int istagged_inline(obj o, int t) { return isobjptr(o) && hblkref(o, 0) == obj_from_size(t); }
#define istagged(o, t) istagged_inline(o, t)
#endif

/* box representation extras */
#define boxbsz()      hbsz(1+1)
#define hend_box()    (*--hp = obj_from_size(BOX_BTAG), hendblk(1+1))

/* pair representation extras */
#define pairbsz()     hbsz(2+1)
#define hend_pair()   (*--hp = obj_from_size(PAIR_BTAG), hendblk(2+1))

/* vector representation extras */
#define vecbsz(n)     hbsz((n)+1)
#define hend_vec(n)   (*--hp = obj_from_size(VECTOR_BTAG), hendblk((n)+1))

/* record representation extras  */
#define recbsz(c)     hbsz((c)+1)
#define hend_rec(rtd, c) (*--hp = rtd, hendblk((c)+1))

/* vm closure representation */
#ifdef NDEBUG /* quick */
#define isvmclo(x)    (isobjptr(x) && isobjptr(hblkref(x, 0)))
#define vmcloref(x,i) hblkref(x, i)
#define vmclolen(x)   hblklen(x)
#define vmclobsz(c)   hbsz(c)
#define hend_vmclo(c) hendblk(c)
#else /* slow but thorough */
#define isvmclo       isprocedure
#define vmcloref      *procedureref
#define vmclolen      procedurelen
#define vmclobsz(c)   hbsz(c)
#define hend_vmclo(c) hendblk(c)
#endif

/* vm tuple representation (c != 1) */
#define istuple(x)    istagged(x, 0)
#define tupleref(x,i) *taggedref(x, 0, i)
#define tuplelen(x)   taggedlen(x, 0)
#define tuplebsz(c)   hbsz((c)+1)
#define hend_tuple(c) (*--hp = obj_from_size(0), hendblk((c)+1))

/* in/re-loading gc-save shadow registers */
#define unload_ip()   (rx = obj_from_fixnum(ip - &vectorref(vmcloref(rd, 0), 0)))
#define reload_ip()   (ip = &vectorref(vmcloref(rd, 0), fixnum_from_obj(rx)))
#define unload_sp()   (rs = obj_from_fixnum(sp - r))
#define reload_sp()   (sp = r + fixnum_from_obj(rs))

/* access to stack, display, global cells */
#define sref(i)       (sp[-(i)-1])
#define dref(i)       (vmcloref(rd, (i)+1))
#define gref(p)       (boxref(p))
#ifdef _DEBUG
static void _sck(obj *s) { 
  assert(s != NULL);
  assert(s >= cxg_regs + VM_REGC);
  assert(s < cxg_rend); 
}
#define spush(o)      (_sck(sp), *sp++ = o)
#define spop()        (_sck(sp), *--sp)
#define sdrop(n)      (_sck(sp), sp -= (n))
#define sgrow(n)      (_sck(sp), sp += (n))
#else
#define spush(o)      (*sp++ = o)
#define spop()        (*--sp)
#define sdrop(n)      (sp -= (n))
#define sgrow(n)      (sp += (n))
#endif

/* reserving heap memory inside instructions */
#define hp_reserve(n) do { \
 if (unlikely(hp < cxg_heap + (n))) { \
   unload_ac(); unload_ip();   \
   hp = cxm_hgc(r, sp, hp, n); \
   reload_ac(); reload_ip();   \
 } } while (0)
#define hp_reserve_inline(n) \
 ((hp < cxg_heap + (n)) \
 ? (unload_ac(), unload_ip(), hp = cxm_hgc(r, sp, hp, (n)), reload_ac(), reload_ip(), hp) \
 : hp)
#define hp_pushptr(p, pt) \
  (hp_reserve_inline(2), *--hp = (obj)(p), *--hp = (obj)(pt), (obj)(hp+1))   

/* object representation extras */
#define bool_obj(b) obj_from_bool(b)
#define is_bool(o) is_bool_obj(o)
#define get_bool(o) bool_from_obj(o)
#define char_obj(b) obj_from_char(b)
#define is_char(o) is_char_obj(o)
#define get_char(o) char_from_obj(o)
#define void_obj() obj_from_void(0)
#define is_void(o) (o == obj_from_void(0))
#define unit_obj() obj_from_unit()
#define is_unit(o) (o == obj_from_unit())
#define null_obj() mknull()
#define is_null(o) isnull(o)
#define eof_obj() mkeof()
#define is_eof(o) ((o) == mkeof())
#define fixnum_obj(x) obj_from_fixnum(x)
#define is_fixnum(o) is_fixnum_obj(o)
#define are_fixnums(o1, o2) (is_fixnum(o1) && is_fixnum(o2))
#define get_fixnum(o) fixnum_from_obj(o)
#define is_byte(o) is_byte_obj(o)
#define byte_obj(x) obj_from_fixnum((unsigned char)(x))
#define get_byte(o) ((unsigned char)fixnum_from_obj(o))
#ifdef FLONUMS_BOXED
#define flonum_obj(x) hp_pushptr(dupflonum(x), FLONUM_NTAG)
#define is_flonum(o) is_flonum_obj(o)
#define get_flonum(o) flonum_from_obj(o)
#else
#define flonum_obj(x) obj_from_flonum(0, x)
#define is_flonum(o) is_flonum_obj(o)
#define get_flonum(o) flonum_from_obj(o)
#endif
#define is_symbol(o) issymbol(o)
#define get_symbol(o) getsymbol(o)
#define is_pair(o) ispair(o)
#define pair_car(o) car(o)
#define pair_cdr(o) cdr(o)
#define is_list(o) islist(o)
#define is_circular(o) iscircular(o)
#define is_noncircular(o) (!iscircular(o))
#define is_vector(o) isvector(o)
#define vector_len(o) vectorlen(o)
#define vector_ref(o, i) vectorref(o, i)
#define string_obj(s) hp_pushptr((s), STRING_NTAG)
#define is_string(o) isstring(o)
#define string_len(o) stringlen(o) 
#define string_ref(o, i) (*stringref(o, i))
#define bytevector_obj(s) hp_pushptr((s), BYTEVECTOR_NTAG)
#define is_bytevector(o) isbytevector(o)
#define bytevector_len(o) bytevectorlen(o)
#define bytevector_ref(o, i) (*bytevectorref(o, i))
#define iport_file_obj(fp) hp_pushptr((fp), IPORT_FILE_NTAG)
#define oport_file_obj(fp) hp_pushptr((fp), OPORT_FILE_NTAG)
#define iport_string_obj(fp) hp_pushptr((fp), IPORT_STRING_NTAG)
#define oport_string_obj(fp) hp_pushptr((fp), OPORT_STRING_NTAG)
#define iport_bytevector_obj(fp) hp_pushptr((fp), IPORT_BYTEVECTOR_NTAG)
#define oport_bytevector_obj(fp) hp_pushptr((fp), OPORT_BYTEVECTOR_NTAG)
#define is_iport(o) isiport(o)
#define is_oport(o) isoport(o)
#define is_box(o) isbox(o)
#define box_ref(o) boxref(o)
#define is_proc(o) isvmclo(o)
#define is_tuple(o) (isrecord(o) && recordrtd(o) == 0)
#define tuple_len(o) tuplelen(o)
#define tuple_ref(o, i) tupleref(o, i)
#define is_record(o) (isrecord(o) && recordrtd(o) != 0)
#define record_rtd(o) recordrtd(o)
#define record_len(o) recordlen(o)
#define record_ref(o, i) recordref(o, i)


/* cxi instructions protocol; retval is new hp: */
typedef obj* regcall (*ins_t)(IPARAMS);

/* calling next instruction and returning from instruction */
#define goih(ih)      musttail return ((ih)(IARGS))
#define goi(name)     musttail return (glue(cxi_, name)(IARGS))
#define gonexti()     musttail return ((ins_from_obj(*ip))(IARGS1))
#define unwindi(c)    return (unload_ac(), unload_ip(), rd = (c), hp)
#define check_sp()    if (unlikely(sp > (obj*)rz)) fail("stack overflow")
#ifdef VM_MUSTTAIL_GUARANTEE
  #define callsubi()  check_sp(); reload_ip(); gonexti()
  #define retfromi()  reload_ip(); gonexti()
  #define trampcnd()  (0)
#else
  #define callsubi()  check_sp(); unload_sp(); return hp
  #define retfromi()  unload_sp(); return hp
  #define trampcnd()  (rd)
#endif


/* defining instruction helpers */
#define define_instrhelper(name) \
  static obj* regcall outofline nochecks name(IPARAMS)

/* defining and binding instructions */
#define define_instruction(name) \
  obj* regcall nochecks glue(cxi_, name)(IPARAMS)
#ifdef VM_INS_CODE_ALIGNED
#define declare_instruction_global(name) \
  obj glue(cx_ins_2D, name) = (obj)(&glue(cxi_, name));
#else
#define declare_instruction_global(name) \
  static ins_t glue(cxib_, name)[1] = { &glue(cxi_, name) }; \
  obj glue(cx_ins_2D, name) = (obj)(&glue(cxib_, name)[0]);
#endif

static obj vmhost(obj);
obj vmcases[13] = { 
  (obj)vmhost, (obj)vmhost, (obj)vmhost, (obj)vmhost, 
  (obj)vmhost, (obj)vmhost, (obj)vmhost, (obj)vmhost,
  (obj)vmhost, (obj)vmhost, (obj)vmhost, (obj)vmhost,
  (obj)vmhost
};
/* vmhost procedure */
static obj vmhost(obj pc)
{
  ILOCALS;
  int rc = cxg_rc, i;
  r = cxg_regs; hp = cxg_hp;
jump: 
  switch (objptr_from_obj(pc)-vmcases) {

  case 0: /* execute-thunk-closure */    
    /* r[0] = self, r[1] = k, r[2] = closure */
    { obj k, arg; 
    assert(rc == 3);
    k = r[1]; arg = r[2];
    r = cxm_rgc(NULL, VM_REGC + VM_STACK_LEN);
    rk = k; /* continuation, kept there */
    ra = obj_from_fixnum(0); /* argc, shadow ac */
    rx = obj_from_fixnum(0); /* shadow ip */ 
    rd = arg; /* thunk closure to execute */
    rs = obj_from_fixnum(VM_REGC); /* sp */
    rz = (obj)(r + VM_STACK_GSZ); /* sp red zone */
    do { /* unwindi trampoline */
      reload_ac(); /* ra => ac */
      reload_ip(); /* rd/rx => ip */
      reload_sp(); /* rs => sp */
      hp = (ins_from_obj(*ip))(IARGS1);
    } while (likely(trampcnd()));
    /* r[0] = k, r[1] = result */
    r[2] = r[1];
    r[1] = obj_from_ktrap();
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 1: /* make-closure */    
    /* r[0] = clo, r[1] = k, r[2] = code */
    { assert(rc == 3);
    r[0] = r[1]; r[1] = r[2]; 
    /* r[0] = k; r[1] = code */
    hreserve(vmclobsz(1), 2); /* 2 live regs */
    *--hp = r[1];
    r[2] = hend_vmclo(1);
    r[1] = obj_from_ktrap();
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 2: /* decode-sexp */    
    /* r[0] = clo, r[1] = k, r[2] = xstr */
    { assert(rc == 3);
    r[0] = r[1]; r[1] = r[2]; 
    /* r[0] = k; r[1] = xstr */
    for (i = 3; i < VM_REGC; ++i) r[i] = 0; 
    rz = (obj)(r + VM_STACK_GSZ); /* sp red zone */
    hp = rds_stox(r, r+VM_REGC, hp); /* r[1] -> r[1] */
    r[2] = r[1]; r[1] = obj_from_ktrap();
    /* r[0] = k; r[1] = ek; r[2] = code */
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 3: /* decode-code */    
    /* r[0] = clo, r[1] = k, r[2] = cstr */
    { assert(rc == 3);
    r[0] = r[1]; r[1] = r[2]; 
    /* r[0] = k; r[1] = cstr */
    for (i = 3; i < VM_REGC; ++i) r[i] = 0;
    rz = (obj)(r + VM_STACK_GSZ); /* sp red zone */
    hp = rds_stoc(r, r+VM_REGC, hp); /* r[1] -> r[1] */
    r[2] = r[1]; r[1] = obj_from_ktrap();
    /* r[0] = k; r[1] = ek; r[2] = code */
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 4: /* find-integrable-encoding */
    /* r[0] = clo, r[1] = k, r[2] = id, r[3] = argc */
    { assert(rc == 4);
    r[2] = obj_from_bool(0);;
    r[0] = r[1]; r[1] = obj_from_ktrap();
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }
      
  case 5: /* encode-integrable */
    /* r[0] = clo, r[1] = k, r[2] = argc, r[3] = pe, r[4] = port */
    { assert(rc == 5);
    assert(0);
    r[0] = r[1]; r[1] = obj_from_ktrap();
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 6: /* install-global-lambdas */
    /* r[0] = clo, r[1] = k */
    { assert(rc == 2);
    r[0] = r[1];
    for (i = 2; i < VM_REGC; ++i) r[i] = 0;
    rz = (obj)(r + VM_STACK_GSZ); /* sp red zone */
    hp = rds_intgtab(r, r+VM_REGC, hp);
    r[1] = obj_from_ktrap();
    r[2] = obj_from_void(0);
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 7: /* initialize-modules */
    /* r[0] = clo, r[1] = k */
    { assert(rc == 2);
    r[0] = r[1];
    r = cxm_rgc(NULL, VM_REGC + VM_STACK_LEN);
    for (i = 2; i < VM_REGC; ++i) r[i] = 0;
    rz = (obj)(r + VM_STACK_GSZ); /* sp red zone */
    hp = init_modules(r, r+VM_REGC, hp);
    r[1] = obj_from_ktrap();
    r[2] = obj_from_void(0);
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 8: /* integrable? */
    /* r[0] = clo, r[1] = k, r[2] = obj */
    { assert(rc == 3);
    r[2] = obj_from_bool(isintegrable(r[2]));
    r[0] = r[1]; r[1] = obj_from_ktrap();
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 9: /* lookup-integrable */
    /* r[0] = clo, r[1] = k, r[2] = id */
    { assert(rc == 3);
    if (issymbol(r[2])) {
      int sym = getsymbol(r[2]);
      struct intgtab_entry *pe = lookup_integrable(sym);
      r[2] = pe ? mkintegrable(pe) : obj_from_bool(0);
    } else r[2] = obj_from_bool(0);
    r[0] = r[1]; r[1] = obj_from_ktrap();
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 10: /* integrable-type */
    /* r[0] = clo, r[1] = k, r[2] = ig */
    { assert(rc == 3);
    if (isintegrable(r[2])) {
      int it = integrable_type(integrabledata(r[2]));
      r[2] = it ? obj_from_char(it) : obj_from_bool(0);
    } else r[2] = obj_from_bool(0);
    r[0] = r[1]; r[1] = obj_from_ktrap();
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 11: /* integrable-global */
    /* r[0] = clo, r[1] = k, r[2] = ig */
    { assert(rc == 3);
    if (isintegrable(r[2])) {
      const char *igs = integrable_global(integrabledata(r[2]));
      r[2] = igs ? mksymbol(internsym((char*)igs)) : obj_from_bool(0);
    } else r[2] = obj_from_bool(0);
    r[0] = r[1]; r[1] = obj_from_ktrap();
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }

  case 12: /* integrable-code */
    /* r[0] = clo, r[1] = k, r[2] = ig, r[3] = i */
    { assert(rc == 4);
    if (isintegrable(r[2]) && is_fixnum(r[3])) {
      const char *cs = integrable_code(integrabledata(r[2]), get_fixnum(r[3]));
      r[2] = cs ? hpushstr(3, newstring((char*)cs)) : obj_from_bool(0);
    } else r[2] = obj_from_bool(0);
    r[0] = r[1]; r[1] = obj_from_ktrap();
    pc = objptr_from_obj(r[0])[0];
    rc = 3;
    goto jump; }
      
  default: /* inter-host call */
    cxg_hp = hp;
    cxm_rgc(r, 1);
    cxg_rc = rc;
    return pc;
  }
}

/* instructions for basic vm machinery */

define_instrhelper(cxi_fail) { 
  fprintf(stderr, "run-time failure: %s\n", (char*)ac);
  ac = void_obj();
  unwindi(0); 
}

define_instrhelper(cxi_failactype) { 
  char *msg = (char*)spop(); obj p;
  fprintf(stderr, "run-time failure: argument is not a %s:\n", msg); 
  p = oport_file_obj(stderr); spush(p);
  oportputcircular(ac, p, 0);
  fputc('\n', stderr);
  spop();
  ac = void_obj();
  unwindi(0); 
}

#define fail(msg) do { ac = (obj)msg; musttail return cxi_fail(IARGS); } while (0)
#define failtype(x, msg) do { ac = (x); spush((obj)msg); musttail return cxi_failactype(IARGS); } while (0) 
#define failactype(msg) do { spush((obj)msg); musttail return cxi_failactype(IARGS); } while (0) 

#define ckp(x) do { obj _x = (x); if (unlikely(!is_pair(_x))) \
  { ac = _x; spush((obj)"pair"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckl(x) do { obj _x = (x); if (unlikely(!is_list(_x))) \
  { ac = _x; spush((obj)"list"); musttail return cxi_failactype(IARGS); } } while (0)
#define cku(x) do { obj _x = (x); if (unlikely(!is_null(_x))) \
  { ac = _x; spush((obj)"proper list"); musttail return cxi_failactype(IARGS); } } while (0)
#define cko(x) do { obj _x = (x); if (unlikely(!is_record(_x))) \
  { ac = _x; spush((obj)"record"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckv(x) do { obj _x = (x); if (unlikely(!is_vector(_x))) \
  { ac = _x; spush((obj)"vector"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckc(x) do { obj _x = (x); if (unlikely(!is_char(_x))) \
  { ac = _x; spush((obj)"char"); musttail return cxi_failactype(IARGS); } } while (0)
#define cks(x) do { obj _x = (x); if (unlikely(!is_string(_x))) \
  { ac = _x; spush((obj)"string"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckb(x) do { obj _x = (x); if (unlikely(!is_bytevector(_x))) \
  { ac = _x; spush((obj)"bytevector"); musttail return cxi_failactype(IARGS); } } while (0)
#define cki(x) do { obj _x = (x); if (unlikely(!is_fixnum(_x))) \
  { ac = _x; spush((obj)"fixnum"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckj(x) do { obj _x = (x); if (unlikely(!is_flonum(_x))) \
  { ac = _x; spush((obj)"flonum"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckn(x) do { obj _x = (x); if (unlikely(!is_fixnum(_x) && !is_flonum(_x))) \
  { ac = _x; spush((obj)"number"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckk(x) do { obj _x = (x); if (unlikely(!is_fixnum(_x) || get_fixnum(_x) < 0)) \
  { ac = _x; spush((obj)"nonnegative fixnum"); musttail return cxi_failactype(IARGS); } } while (0)
#define ck8(x) do { obj _x = (x); if (unlikely(!is_byte(_x))) \
  { ac = _x; spush((obj)"byte"); musttail return cxi_failactype(IARGS); } } while (0)
#define cky(x) do { obj _x = (x); if (unlikely(!is_symbol(_x))) \
  { ac = _x; spush((obj)"symbol"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckr(x) do { obj _x = (x); if (unlikely(!is_iport(_x))) \
  { ac = _x; spush((obj)"input port"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckw(x) do { obj _x = (x); if (unlikely(!is_oport(_x))) \
  { ac = _x; spush((obj)"output port"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckx(x) do { obj _x = (x); if (unlikely(!is_proc(_x))) \
  { ac = _x; spush((obj)"procedure"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckz(x) do { obj _x = (x); if (unlikely(!is_box(_x))) \
  { ac = _x; spush((obj)"box, cell, or promise"); musttail return cxi_failactype(IARGS); } } while (0)
#define ckg(x) do { obj _x = (x); if (unlikely(!isintegrable(_x))) \
  { ac = _x; spush((obj)"integrable entry"); musttail return cxi_failactype(IARGS); } } while (0)


define_instruction(halt) { 
  unwindi(0); 
}

define_instruction(panic) {
  obj l, p; cks(ac); ckl(sref(0));
  p = oport_file_obj(stderr);  
  fprintf(stderr, "error: %s", stringchars(ac));
  if (is_pair(sref(0))) fputs(":\n", stderr); 
  else fputs("\n", stderr);
  for (l = sref(0); is_pair(l); l = pair_cdr(l)) {
    oportputcircular(pair_car(l), p, 0);
    fputc('\n', stderr);
  }
  sdrop(1);
  ac = void_obj();
  unwindi(0); 
}

define_instruction(abort) {
  /* exit code ignored */
  abort();
  unwindi(0);
}

define_instruction(exit) {
  int excode;
  if (ac == bool_obj(0)) excode = 1;
  else if (ac == bool_obj(1)) excode = 0;
  else if (is_fixnum(ac)) excode = (int)get_fixnum(ac);
  else excode = 1;
  exit(excode);
  unwindi(0);
}


define_instruction(lit) { 
  ac = *ip++; 
  gonexti();
}

define_instruction(sref) {
  int i = get_fixnum(*ip++);
  ac = sref(i);
  gonexti();
}  

define_instruction(dref) {
  int i = get_fixnum(*ip++);
  ac = dref(i); 
  gonexti();
}

define_instruction(gref) {
  obj p = *ip++; 
  ac = gref(p);
  gonexti();
}

define_instruction(iref) {
  ac = box_ref(ac);
  gonexti();
}

define_instruction(iset) {
  box_ref(ac) = spop();
  gonexti();
}

define_instruction(dclose) {
  int i, n = get_fixnum(*ip++), c = n+1; 
  hp_reserve(vmclobsz(c));
  for (i = n-1; i >= 0; --i) *--hp = sref(i); /* display */
  *--hp = *ip++; /* code */
  ac = hend_vmclo(c); /* closure */
  sdrop(n);   
  gonexti();
}

define_instruction(sbox) {
  int i = get_fixnum(*ip++); 
  hp_reserve(boxbsz());
  *--hp = sref(i);  
  sref(i) = hend_box();
  gonexti();
}

define_instruction(br) { 
  int dx = get_fixnum(*ip++); 
  ip += dx; 
  gonexti(); 
}

define_instruction(brt) { 
  int dx = get_fixnum(*ip++);
  if (ac) ip += dx; 
  gonexti(); 
}

define_instruction(brnot) { 
  int dx = get_fixnum(*ip++);
  if (!ac) ip += dx; 
  gonexti(); 
}

define_instruction(andbo) {
  if (ac) { /* go to next binary instruction w/2 args */
    ac = spop();
  } else { /* skip the next instruction, drop its args */
    sdrop(2);
    ip += 1;
  }
  gonexti(); 
}

define_instruction(sseti) {
  int i = get_fixnum(*ip++);
  box_ref(sref(i)) = ac;
  gonexti();
}

define_instruction(dseti) {
  int i = get_fixnum(*ip++);
  box_ref(dref(i)) = ac;
  gonexti();
}

define_instruction(gloc) {
  ac = *ip++;
  gonexti();
}

define_instruction(gset) {
  obj p = *ip++;
  gref(p) = ac;
  gonexti();
}

define_instruction(appl) {
  int n, i; obj l = spop(), t = l;
  for (n = 0; is_pair(t); t = pair_cdr(t)) ++n; sgrow(n);
  for (i = 0; i < n; ++i, l = pair_cdr(l)) sref(i) = pair_car(l);
  ckx(ac); rd = ac; rx = fixnum_obj(0);
  ac = fixnum_obj(n); /* argc */
  callsubi();
}

define_instruction(cwmv) {
  obj t = ac, x = spop();
  ckx(t); ckx(x);
  /* we can run in constant space in some situations */
  if (vmcloref(x, 0) == cx_continuation_2Dadapter_2Dcode 
   && vmcloref(x, 1) ==  cx__2Adynamic_2Dstate_2A) {
    /* arrange call of t with x as continuation */
    /* [0] adapter_code, [1] dynamic_state */
    int n = vmclolen(x) - 2; 
    assert((cxg_rend - cxg_regs - VM_REGC) > n);
    sp = r + VM_REGC; /* stack is empty */
    objcpy(sp, &vmcloref(x, 2), n);
    sp += n; /* contains n elements now */
    rd = t; rx = fixnum_obj(0); 
    ac = fixnum_obj(0);
    callsubi();
  } else { 
    /* arrange return to cwmv code w/x */
    spush(x);
    spush(cx_callmv_2Dadapter_2Dclosure); 
    spush(fixnum_obj(0));
    /* call the producer */
    rd = t; rx = fixnum_obj(0); ac = fixnum_obj(0); 
    callsubi(); 
  }
}

define_instruction(rcmv) {
  /* single-value producer call returns here with result in ac, cns on stack */
  obj val = ac, x = spop();
  /* tail-call the consumer with the returned value(s) */
  if (is_unit(val)) { /* (values) in improper context */
    ac = fixnum_obj(0);
  } else if (is_tuple(val)) { /* (values a1 a2 a ...) in improper context */
    int n = tuple_len(val), i;
    for (i = n-1; i >= 0; --i) spush(tuple_ref(val, i));
    ac = fixnum_obj(n);
  } else { /* regular single value */ 
    spush(val); ac = fixnum_obj(1);
  }
  rd = x; rx = fixnum_obj(0); 
  callsubi();
}

define_instruction(sdmv) {
  /* sending values on stack, ac contains argc */
  if (ac == fixnum_obj(1)) {
    /* can return anywhere, including rcmv */
    ac = spop();
    rx = spop();
    rd = spop();
    retfromi();
  } else {
    /* can only pseudo-return to rcmv */
    int n = get_fixnum(ac), m = 3, i;
    if (sref(n) == fixnum_obj(0) && sref(n+1) == cx_callmv_2Dadapter_2Dclosure) {
      /* tail-call the consumer with the produced values */
      rd = sref(n+2); rx = fixnum_obj(0); /* cns */
      /* NB: can be sped up for popular cases: n == 0, n == 2 */
      objmove_left(sp-n-m, sp-n, n);
      sdrop(m); callsubi();
    } else if (n == 0) { /* return unit (n = 0) */
      ac = unit_obj();
      rx = spop();
      rd = spop();
      retfromi();
    } else { /* return args as tuple (n > 1) */
      hp_reserve(tuplebsz(n));
      for (i = n-1; i >= 0; --i) *--hp = sref(i);
      ac = hend_tuple(n);
      sdrop(n);
      rx = spop();
      rd = spop();
      retfromi();
    }
  }
}

define_instruction(lck) {
  int m = get_fixnum(*ip++);
  int n; cki(sref(m)); ckx(sref(m+1));
  n = (int)(sp-m-(r+VM_REGC));
  hp_reserve(vmclobsz(n+2));
  hp -= n; objcpy(hp, sp-n-m, n);
  /* [0] adapter_code, [1] dynamic_state */
  *--hp = cx__2Adynamic_2Dstate_2A;
  *--hp = cx_continuation_2Dadapter_2Dcode;
  ac = hend_vmclo(n+2);
  gonexti();
}

define_instruction(lck0) {
  int n; cki(sref(0)); ckx(sref(1));
  n = (int)(sp-(r+VM_REGC));
  hp_reserve(vmclobsz(n+2));
  hp -= n; objcpy(hp, sp-n, n);
  /* [0] adapter_code, [1] dynamic_state */
  *--hp = cx__2Adynamic_2Dstate_2A;
  *--hp = cx_continuation_2Dadapter_2Dcode;
  ac = hend_vmclo(n+2);
  gonexti();
}

define_instruction(wck) {
  obj x = ac, t = spop(); ckx(t); ckx(x);
  if (vmcloref(x, 0) != cx_continuation_2Dadapter_2Dcode) 
    failactype("continuation");
  /* [0] adapter_code, [1] dynamic_state */
  if (vmcloref(x, 1) == cx__2Adynamic_2Dstate_2A) {
    /* restore cont stack and invoke t there */
    int n = vmclolen(x) - 2; 
    assert((cxg_rend - cxg_regs - VM_REGC) > n);
    sp = r + VM_REGC; /* stack is empty */
    objcpy(sp, &vmcloref(x, 2), n);
    sp += n; /* contains n elements now */
    rd = t; rx = fixnum_obj(0); 
    ac = fixnum_obj(0);
    callsubi();
  } else {
    /* have to arrange call of cont adapter */
    spush(x);
    spush(cx_callmv_2Dadapter_2Dclosure); 
    spush(fixnum_obj(0));
    /* call the thunk as producer */
    rd = t; rx = fixnum_obj(0); 
    ac = fixnum_obj(0); 
    callsubi(); 
  }
}

define_instruction(wckr) {
  obj x = ac, o = spop(); ckx(x);
  if (vmcloref(x, 0) != cx_continuation_2Dadapter_2Dcode) 
    failactype("continuation");
  /* [0] adapter_code, [1] dynamic_state */
  if (vmcloref(x, 1) == cx__2Adynamic_2Dstate_2A) {
    /* restore cont stack and return o there */
    int n = vmclolen(x) - 2;
    assert((cxg_rend - cxg_regs - VM_REGC) > n);
    sp = r + VM_REGC; /* stack is empty */
    objcpy(sp, &vmcloref(x, 2), n);
    sp += n;
    ac = o;
    rx = spop();
    rd = spop();
    retfromi();
  } else {
    /* have to arrange call of cont adapter */
    spush(o);
    rd = x; rx = fixnum_obj(0); 
    ac = fixnum_obj(1); 
    callsubi(); 
  }
}


define_instruction(rck) {
  /* called with continuation as rd: 
   * in: ac:argc, args on stack, rd display is dys, saved stack */
  if (vmcloref(rd, 1) != cx__2Adynamic_2Dstate_2A) {
    /* need to run the rest of the code to unwind/rewind on the
     * old stack; rck will be called again when done */
    gonexti(); 
  } else if (ac == fixnum_obj(1)) { /* easy, popular case */
    ac = rd; 
    goi(wckr);
  } else { /* multiple results case */
    /* rd[0] adapter_code, rd[1] dynamic_state */
    int c = get_fixnum(ac), n = vmclolen(rd) - 2, i;
    obj *ks = &vmcloref(rd, 2), *ke = ks + n;
    if (ke-ks > 3 && *--ke == fixnum_obj(0) && *--ke == cx_callmv_2Dadapter_2Dclosure) {
      obj *sb = r + VM_REGC;
      rd = *--ke; rx = fixnum_obj(0); n = ke - ks; /* cns */
      /* arrange stack as follows: [ks..ke] [arg ...] */
      assert((cxg_rend - cxg_regs - VM_REGC) > n + c);
      if (c) objmove(sb+n, sp-c, c);
      objcpy(sb, ks, n);
      sp = sb+n+c; callsubi();
    } else if (c == 0) { /* return unit (n = 0) */
      spush(unit_obj());
      ac = rd;
      goi(wckr);
    } else { /* return args as tuple (n > 1) */
      hp_reserve(tuplebsz(c));
      for (i = c-1; i >= 0; --i) *--hp = sref(i);
      ac = hend_tuple(c);
      sdrop(c);
      spush(ac);
      ac = rd;
      goi(wckr);
    }
  } 
}

define_instruction(dys) {
  ac = cx__2Adynamic_2Dstate_2A;
  gonexti();
}

define_instruction(setdys) {
  cx__2Adynamic_2Dstate_2A = ac;
  gonexti();
}

define_instruction(save) {
  int dx = get_fixnum(*ip++); 
  spush(rd);
  spush(fixnum_obj(ip + dx - &vector_ref(vmcloref(rd, 0), 0)));  
  gonexti();
}

define_instruction(push) { spush(ac); gonexti(); }

define_instruction(jdceq) {
  obj v = *ip++, i = *ip++;
  if (ac == v) {
    rd = dref(get_fixnum(i));
    rx = fixnum_obj(0);
    callsubi();
  }
  gonexti();
}

define_instruction(jdcge) {
  obj v = *ip++, i = *ip++;
  if (ac >= v) { /* unsigned tagged fixnums can be compared as-is */
    rd = dref(get_fixnum(i));
    rx = fixnum_obj(0);
    callsubi();
  }
  gonexti();
}

define_instruction(jdref) {
  int i = get_fixnum(*ip++); 
  rd = dref(i); 
  rx = fixnum_obj(0);
  callsubi();
}

define_instruction(call) {
  int n = get_fixnum(*ip++); 
  ckx(ac); rd = ac; rx = fixnum_obj(0); 
  ac = fixnum_obj(n); /* argc */
  callsubi();
}

define_instruction(scall) {
  int m = get_fixnum(*ip++), n = get_fixnum(*ip++);
  ckx(ac); rd = ac; rx = fixnum_obj(0); 
  ac = fixnum_obj(n); /* argc */
  objmove_left(sp-n-m, sp-n, n);
  sdrop(m);
  callsubi();
}

define_instruction(return) {
  rx = spop();
  rd = spop();
  retfromi();
}

define_instruction(sreturn) {
  int n = get_fixnum(*ip++); 
  sdrop(n);
  rx = spop();
  rd = spop();
  retfromi();
}

define_instruction(adrop) {
  int n = get_fixnum(*ip++); 
  sdrop(n);
  gonexti();
}

define_instruction(pop) { 
  ac = spop(); 
  gonexti();
}

define_instruction(atest) {
  obj no = *ip++;
  if (unlikely(ac != no)) fail("argument count error on entry");
  gonexti();
}

define_instruction(shrarg) {
  int n = get_fixnum(*ip++), c = get_fixnum(ac), m = c-n; 
  /* rest arg ends up on top */
  if (unlikely(m < 0)) {
    fail("argument count error on entry (not enough arguments)");
  } else if (unlikely(m == 0)) {
    spush(null_obj());
  } else {
    obj l = null_obj();
    hp_reserve(pairbsz()*m);
    while (m > 0) { 
      *--hp = l; *--hp = sref(n + m - 1);
      l = hend_pair(); 
      --m;
    }
    objmove_left(sp-c, sp-n, n);
    sdrop(c-n);
    spush(l); 
  }
  ac = fixnum_obj(n+1);
  gonexti();
}

define_instruction(aerr) {
  fail("argument count error on entry");
  gonexti();
}

define_instruction(shlit) { 
  spush(ac); 
  ac = *ip++; 
  gonexti();
}

define_instruction(shi0) { 
  spush(ac);
  ac = fixnum_obj(0);
  gonexti();
}


/* type checks */

define_instruction(ckp) { ckp(ac); gonexti(); }
define_instruction(ckl) { ckl(ac); gonexti(); }
define_instruction(ckv) { ckv(ac); gonexti(); }
define_instruction(ckc) { ckc(ac); gonexti(); }
define_instruction(cks) { cks(ac); gonexti(); }
define_instruction(cki) { cki(ac); gonexti(); }
define_instruction(ckj) { ckj(ac); gonexti(); }
define_instruction(ckn) { ckn(ac); gonexti(); }
define_instruction(ckk) { ckk(ac); gonexti(); }
define_instruction(cky) { cky(ac); gonexti(); }
define_instruction(ckr) { ckr(ac); gonexti(); }
define_instruction(ckw) { ckw(ac); gonexti(); }
define_instruction(ckx) { ckx(ac); gonexti(); }
define_instruction(ckz) { ckz(ac); gonexti(); }


/* integrable instructions */

define_instruction(isq) {
  obj x = ac, y = spop();
  ac = bool_obj(x == y);
  gonexti(); 
}

define_instruction(isv) {
  obj x = ac, y = spop();
  ac = bool_obj(iseqv(x,y));
  gonexti(); 
}

define_instruction(ise) {
  obj x = ac, y = spop();
  ac = bool_obj(isequal(x,y));
  gonexti(); 
}

define_instruction(unbox) { 
  ckz(ac); 
  ac = box_ref(ac); 
  gonexti(); 
}

define_instruction(setbox) { 
  ckz(ac); 
  box_ref(ac) = spop(); 
  gonexti(); 
}

define_instruction(box) {
  hp_reserve(boxbsz());
  *--hp = ac;
  ac = hend_box();
  gonexti();
}

define_instruction(car) { ckp(ac); ac = pair_car(ac); gonexti(); }
define_instruction(cdr) { ckp(ac); ac = pair_cdr(ac); gonexti(); }
define_instruction(setcar) { ckp(ac); pair_car(ac) = spop(); gonexti(); }
define_instruction(setcdr) { ckp(ac); pair_cdr(ac) = spop(); gonexti(); }

define_instruction(caar) { ckp(ac); ac = pair_car(ac); ckp(ac); ac = pair_car(ac); gonexti(); }
define_instruction(cadr) { ckp(ac); ac = pair_cdr(ac); ckp(ac); ac = pair_car(ac); gonexti(); }
define_instruction(cdar) { ckp(ac); ac = pair_car(ac); ckp(ac); ac = pair_cdr(ac); gonexti(); }
define_instruction(cddr) { ckp(ac); ac = pair_cdr(ac); ckp(ac); ac = pair_cdr(ac); gonexti(); }


define_instruction(nullp) {
  ac = bool_obj(is_null(ac));
  gonexti();
}

define_instruction(pairp) {
  ac = bool_obj(is_pair(ac));
  gonexti();
}

define_instruction(cons) {
  hp_reserve(pairbsz());
  *--hp = spop(); /* cdr */
  *--hp = ac;     /* car */
  ac = hend_pair();
  gonexti();
}

define_instruction(listp) {
  ac = bool_obj(is_list(ac));
  gonexti();
}

define_instruction(list) {
  int i, n = get_fixnum(*ip++);
  hp_reserve(pairbsz()*n);
  for (ac = null_obj(), i = n-1; i >= 0; --i) {
    *--hp = ac;      /* cdr */
    *--hp = sref(i); /* car */
    ac = hend_pair();
  }
  sdrop(n);
  gonexti();
}

define_instruction(lmk) {
  int i, n; obj v; ckk(ac);
  n = get_fixnum(ac); 
  hp_reserve(pairbsz()*n); v = sref(0);
  ac = null_obj();
  for (i = 0; i < n; ++i) {
    *--hp = ac; /* cdr */
    *--hp = v;  /* car */
    ac = hend_pair();
  }
  sdrop(1);
  gonexti();
}

define_instruction(llen) {
  int n = 0;
  while (is_pair(ac)) { ac = pair_cdr(ac); ++n; }
  ac = fixnum_obj(n);
  gonexti();
}

define_instruction(lget) {
  obj x = spop(); int c;
  ckk(x); c = get_fixnum(x);
  while (c-- > 0) { ckp(ac); ac = pair_cdr(ac); }
  ckp(ac); ac = pair_car(ac);
  gonexti();
}

define_instruction(lput) {
  obj x = spop(); int c;
  ckk(x); c = get_fixnum(x);
  while (c-- > 0) { ckp(ac); ac = pair_cdr(ac); }
  ckp(ac); pair_car(ac) = spop();
  gonexti();
}


define_instruction(memq) {
  obj l = spop(); 
  for (; is_pair(l); l = pair_cdr(l)) {
    if (pair_car(l) == ac) { ac = l; gonexti(); }
  }
  ac = bool_obj(0);
  gonexti();
}

define_instruction(memv) {
  ac = ismemv(ac, spop()); /* FIXME: ckp() */
  gonexti();
}

define_instruction(meme) {
  ac = ismember(ac, spop()); /* FIXME: ckp() */
  gonexti();
}

define_instruction(assq) {
  obj l = spop(); 
  for (; is_pair(l); l = pair_cdr(l)) {
    obj p = pair_car(l); if (is_pair(p) && pair_car(p) == ac) { ac = p; gonexti(); }
  }
  ac = bool_obj(0);
  gonexti();
}

define_instruction(assv) {
  ac = isassv(ac, spop()); /* FIXME: ckp() */
  gonexti();
}

define_instruction(asse) {
  ac = isassoc(ac, spop()); /* FIXME: ckp() */
  gonexti();
}

define_instruction(ltail) {
  obj x = spop(); int c;
  ckk(x); c = get_fixnum(x);
  while (c-- > 0) { ckp(ac); ac = pair_cdr(ac); }
  gonexti();
}

define_instruction(lpair) {
  obj l = bool_obj(0);
  while (is_pair(ac)) { l = ac; ac = pair_cdr(ac); }
  ac = l;
  gonexti();
}

define_instruction(lrev) {
  obj l = ac, o = null_obj(); int n = 0;
  while (is_pair(ac)) { ac = pair_cdr(ac); ++n; }
  cku(ac); ac = l;
  hp_reserve(pairbsz()*n);
  for (; ac != null_obj(); ac = pair_cdr(ac)) { 
    *--hp = o; *--hp = pair_car(ac);
    o = hend_pair(); 
  }
  ac = o;
  gonexti();
}

define_instruction(lrevi) {
  obj t, v = null_obj();
  while (is_pair(ac)) t = pair_cdr(ac), pair_cdr(ac) = v, v = ac, ac = t;
  ac = v;
  gonexti();
}

define_instruction(circp) {
  ac = bool_obj(is_circular(ac));
  gonexti();
}

define_instruction(charp) {
  ac = bool_obj(is_char(ac));
  gonexti();
}

define_instruction(strp) {
  ac = bool_obj(is_string(ac));
  gonexti();
}

define_instruction(str) {
  int i, n = get_fixnum(*ip++);
  obj o = string_obj(allocstring(n, ' '));
  unsigned char *s = (unsigned char *)stringchars(o);
  for (i = 0; i < n; ++i) {
    obj x = sref(i); ckc(x); s[i] = get_char(x);
  }
  sdrop(n); ac = o;
  gonexti();
}

define_instruction(smk) {
  int n, c; obj x = spop(); 
  ckk(ac); ckc(x);
  n = get_fixnum(ac), c = get_char(x);
  ac = string_obj(allocstring(n, c)); 
  gonexti();
}

define_instruction(slen) {
  cks(ac);
  ac = fixnum_obj(string_len(ac));
  gonexti();
}

define_instruction(sget) {
  obj x = spop(); int i; 
  cks(ac); ckk(x); 
  i = get_fixnum(x); 
  if (i >= string_len(ac)) failtype(x, "valid string index");
  ac = char_obj(string_ref(ac, i));
  gonexti();
}

define_instruction(sput) {
  obj x = spop(), y = spop(); int i; 
  cks(ac); ckk(x); ckc(y); 
  i = get_fixnum(x); 
  if (i >= string_len(ac)) failtype(x, "valid string index");
  string_ref(ac, i) = get_char(y);
  gonexti();
}

define_instruction(scat) {
  obj x = ac, y = spop(); int *d; 
  cks(x); cks(y);
  d = stringcat(stringdata(x), stringdata(y));
  ac = string_obj(d);
  gonexti();
}

define_instruction(ssub) {
  obj x = spop(), y = spop(); int is, ie, *d; 
  cks(ac); ckk(x); ckk(y); 
  is = get_fixnum(x), ie = get_fixnum(y);
  if (is > ie) failtype(x, "valid start string index");
  if (ie > string_len(ac)) failtype(y, "valid end string index");
  d = substring(stringdata(ac), is, ie);
  ac = string_obj(d);
  gonexti();
}

define_instruction(spos) {
  obj x = ac, y = spop(); char *s, *p;
  ckc(x); cks(y);
  s = stringchars(y), p = strchr(s, get_char(x));
  ac = p ? fixnum_obj(p-s) : bool_obj(0);
  gonexti();
}

define_instruction(supc) {
  int *d; char *s; cks(ac);
  d = dupstring(stringdata(ac)); 
  for (s = sdatachars(d); *s; ++s) *s = toupper(*s);
  ac = string_obj(d);
  gonexti();
}

define_instruction(sdnc) {
  int *d; char *s; cks(ac);
  d = dupstring(stringdata(ac)); 
  for (s = sdatachars(d); *s; ++s) *s = tolower(*s);
  ac = string_obj(d);
  gonexti();
}

define_instruction(sflc) {
  int *d; char *s; cks(ac);
  d = dupstring(stringdata(ac)); 
  for (s = sdatachars(d); *s; ++s) *s = tolower(*s); /* stub */
  ac = string_obj(d);
  gonexti();
}


define_instruction(bvecp) {
  ac = bool_obj(is_bytevector(ac));
  gonexti();
}

define_instruction(bvec) {
  int i, n = get_fixnum(*ip++);
  obj o = bytevector_obj(allocbytevector(n));
  unsigned char *s = (unsigned char *)bytevectorbytes(o);
  for (i = 0; i < n; ++i) {
    obj x = sref(i); ck8(x); s[i] = byte_from_obj(x);
  }
  sdrop(n); ac = o;
  gonexti();
}

define_instruction(bmk) {
  int n, b; obj x = spop(); 
  ckk(ac); ck8(x);
  n = get_fixnum(ac), b = byte_from_obj(x);
  ac = bytevector_obj(makebytevector(n, b)); 
  gonexti();
}

define_instruction(blen) {
  ckb(ac);
  ac = fixnum_obj(bytevector_len(ac));
  gonexti();
}

define_instruction(bget) {
  obj x = spop(); int i; 
  ckb(ac); ckk(x); 
  i = get_fixnum(x); 
  if (i >= bytevector_len(ac)) failtype(x, "valid bytevector index");
  ac = fixnum_obj(bytevector_ref(ac, i));
  gonexti();
}

define_instruction(bput) {
  obj x = spop(), y = spop(); int i; 
  ckb(ac); ckk(x); ck8(y); 
  i = get_fixnum(x); 
  if (i >= bytevector_len(ac)) failtype(x, "valid bytevector index");
  bytevector_ref(ac, i) = byte_from_obj(y);
  gonexti();
}

define_instruction(bsub) {
  obj x = spop(), y = spop(); int is, ie, *d; 
  ckb(ac); ckk(x); ckk(y); 
  is = get_fixnum(x), ie = get_fixnum(y);
  if (is > ie) failtype(x, "valid start bytevector index");
  if (ie > bytevector_len(ac)) failtype(y, "valid end bytevector index");
  d = subbytevector(bytevectordata(ac), is, ie);
  ac = bytevector_obj(d);
  gonexti();
}

define_instruction(beq) {
  obj x = ac, y = spop(); ckb(x); ckb(y);
  ac = bool_obj(bytevectoreq(bytevectordata(x), bytevectordata(y)));
  gonexti(); 
}


define_instruction(recp) {
  obj x = ac, y = spop();
  if (is_void(y)) {
    ac = bool_obj(is_record(ac));
  } else {
    ac = bool_obj(is_record(ac) && record_rtd(ac) == y);
  }
  gonexti();
}

define_instruction(rmk) {
  int i, n; obj v; ckk(sref(0));
  n = get_fixnum(sref(0)); 
  hp_reserve(recbsz(n)); v = sref(1);
  for (i = 0; i < n; ++i) *--hp = v;
  ac = hend_rec(ac, n);
  sdrop(2);
  gonexti();
}

define_instruction(rlen) {
  cko(ac);
  ac = fixnum_obj(record_len(ac));
  gonexti();
}

define_instruction(rget) {
  obj x = spop(); int i; 
  cko(ac); ckk(x); 
  i = get_fixnum(x);
  if (i >= record_len(ac)) failtype(x, "valid record index");
  ac = record_ref(ac, i);
  gonexti();
}

define_instruction(rput) {
  obj x = spop(), y = spop(); int i; 
  cko(ac); ckk(x);
  i = get_fixnum(x);
  if (i >= record_len(ac)) failtype(x, "valid record index");
  record_ref(ac, i) = y;
  gonexti();
}

define_instruction(rrtd) {
  cko(ac);
  ac = record_rtd(ac);
  gonexti();
}


define_instruction(vecp) {
  ac = bool_obj(is_vector(ac));
  gonexti();
}

define_instruction(vec) {
  int i, n = get_fixnum(*ip++);
  hp_reserve(vecbsz(n));
  for (i = n-1; i >= 0; --i) *--hp = sref(i);
  ac = hend_vec(n);
  sdrop(n);
  gonexti();
}

define_instruction(vmk) {
  int i, n; obj v; ckk(ac);
  n = get_fixnum(ac); 
  hp_reserve(vecbsz(n)); v = sref(0);
  for (i = 0; i < n; ++i) *--hp = v;
  ac = hend_vec(n);
  sdrop(1);
  gonexti();
}

define_instruction(vlen) {
  ckv(ac);
  ac = fixnum_obj(vector_len(ac));
  gonexti();
}

define_instruction(vget) {
  obj x = spop(); int i; 
  ckv(ac); ckk(x); 
  i = get_fixnum(x);
  if (i >= vector_len(ac)) failtype(x, "valid vector index");
  ac = vector_ref(ac, i);
  gonexti();
}

define_instruction(vput) {
  obj x = spop(), y = spop(); int i; 
  ckv(ac); ckk(x);
  i = get_fixnum(x);
  if (i >= vector_len(ac)) failtype(x, "valid vector index");
  vector_ref(ac, i) = y;
  gonexti();
}

define_instruction(vcat) {
  obj x = ac, y = sref(0); int n1, n2, n;
  ckv(x); ckv(y);
  n1 = vector_len(x), n2 = vector_len(y), n = n1 + n2;
  hp_reserve(vecbsz(n));
  /* NB: vector_ref fails to return pointer to empty vector's start */
  hp -= n2; if (n2) objcpy(hp, &vector_ref(y, 0), n2);
  hp -= n1; if (n1) objcpy(hp, &vector_ref(x, 0), n1);
  ac = hend_vec(n);
  sdrop(1);
  gonexti();
}

define_instruction(vtol) {
  obj l = null_obj(); int n;
  ckv(ac); n = vector_len(ac);
  hp_reserve(pairbsz()*n);
  while (n > 0) {
    *--hp = l; *--hp = vector_ref(ac, n-1);
    l = hend_pair();
    --n;
  }
  ac = l;
  gonexti();
}

define_instruction(ltov) {
  obj l = ac; int n = 0, i;
  while (is_pair(l)) { l = pair_cdr(l); ++n; } cku(l);
  hp_reserve(vecbsz(n));
  for (l = ac, i = 0, hp -= n; i < n; ++i, l = pair_cdr(l)) hp[i] = pair_car(l);
  ac = hend_vec(n);
  gonexti();
}

define_instruction(ltob) {
  obj l = ac, o; int n = 0, i; unsigned char *s;
  while (is_pair(l)) { l = pair_cdr(l); ++n; } cku(l);
  o = bytevector_obj(allocbytevector(n));
  s = bytevectorbytes(o);
  for (i = 0, l = ac; i < n; ++i, l = pair_cdr(l)) {
    obj x = pair_car(l); ck8(x);
    s[i] = get_byte(x);
  } 
  ac = o;
  gonexti();
}

define_instruction(stol) {
  obj l = null_obj(); int n;
  cks(ac); n = string_len(ac);
  hp_reserve(pairbsz()*n);
  while (n > 0) {
    *--hp = l; *--hp = char_obj(string_ref(ac, n-1));
    l = hend_pair();
    --n;
  }
  ac = l;
  gonexti();
}

define_instruction(ltos) {
  obj l = ac; int n = 0, i, *d;
  while (is_pair(l)) { l = pair_cdr(l); ++n; }
  d = allocstring(n, ' ');
  for (i = 0; i < n; ac = pair_cdr(ac), ++i)
    sdatachars(d)[i] = get_char(pair_car(ac));
  ac = string_obj(d);
  gonexti();
}

define_instruction(ytos) {
  cky(ac);
  ac = string_obj(newstring(symbolname(get_symbol(ac))));
  gonexti();
}

define_instruction(stoy) {
  cks(ac);
  ac = mksymbol(internsym(stringchars(ac)));
  gonexti();
}

define_instruction(itos) {
  char buf[35], *s = buf + sizeof(buf) - 1; 
  int neg = 0; long num, radix;
  obj x = ac, y = spop(); cki(x); ckk(y);
  num = get_fixnum(x), radix = get_fixnum(y);
  if (num < 0) { neg = 1; num = -num; }
  if (radix < 2 || radix > 10 + 'z' - 'a') failtype(y, "valid radix");
  *s = 0;
  do { int d = num % radix; *--s = d < 10 ? d + '0' : d - 10 + 'a'; }
  while (num /= radix);
  if (neg) *--s = '-';
  ac = string_obj(newstring(s));  
  gonexti();
}

define_instruction(stoi) {
  char *e, *s; long l, radix;
  obj x = ac, y = spop(); cks(x); ckk(y);
  s = stringchars(x); radix = get_fixnum(y);
  if (radix < 2 || radix > 10 + 'z' - 'a') failtype(y, "valid radix");
  if (s[0] == '#' && (s[1] == 'b' || s[1] == 'B')) s += 2, radix = 2;
  else if (s[0] == '#' && (s[1] == 'o' || s[1] == 'O')) s += 2, radix = 8;
  else if (s[0] == '#' && (s[1] == 'd' || s[1] == 'D')) s += 2, radix = 10;
  else if (s[0] == '#' && (s[1] == 'x' || s[1] == 'X')) s += 2, radix = 16;
  l = (errno = 0, strtol(s, &e, radix));
  if (errno || l < FIXNUM_MIN || l > FIXNUM_MAX || e == s || *e) ac = bool_obj(0);
  else ac = fixnum_obj(l);
  gonexti();
}

define_instruction(ctoi) {
  ckc(ac);
  ac = fixnum_obj(get_char(ac));
  gonexti();
}

define_instruction(itoc) {
  cki(ac); /* TODO: range check? */
  ac = char_obj(get_fixnum(ac));
  gonexti();
}

define_instruction(jtos) {
  char buf[30], *s; double d; ckj(ac);
  d = get_flonum(ac); sprintf(buf, "%.15g", d);
  for (s = buf; *s != 0; s++) if (strchr(".eE", *s)) break;
  if (d != d) strcpy(buf, "+nan.0"); else if (d <= -HUGE_VAL) strcpy(buf, "-inf.0");
  else if (d >= HUGE_VAL) strcpy(buf, "+inf.0"); else if (*s == 'E') *s = 'e'; 
  else if (*s == 0) {  *s++ = '.'; *s++ = '0'; *s = 0; }
  ac = string_obj(newstring(buf));
  gonexti();
}

define_instruction(stoj) {
  char *e = "", *s; double d; cks(ac);
  s = stringchars(ac); errno = 0;
  if (*s != '+' && *s != '-') d = strtod(s, &e);
  else if (strcmp_ci(s+1, "inf.0") == 0) d = (*s == '-' ? -HUGE_VAL : HUGE_VAL); 
  else if (strcmp_ci(s+1, "nan.0") == 0) d = HUGE_VAL - HUGE_VAL; 
  else d = strtod(s, &e);
  if (errno || e == s || *e) ac = bool_obj(0);
  else ac = flonum_obj(d);
  gonexti();
}

define_instruction(ntos) {
  if (is_fixnum(ac)) goi(itos);
  if (unlikely(spop() != fixnum_obj(10))) fail("non-10 radix in flonum conversion");
  goi(jtos);
}

define_instruction(ston) {
  char *s; int radix; long l; double d;
  obj x = ac, y = spop(); cks(x); ckk(y);
  s = stringchars(x); radix = get_fixnum(y);
  if (radix < 2 || radix > 10 + 'z' - 'a') failtype(y, "valid radix");
  switch (strtofxfl(s, radix, &l, &d)) {
    case 'e': ac = fixnum_obj(l); break;
    case 'i': ac = flonum_obj(d); break;
    default : ac = bool_obj(0); break;
  }
  gonexti();
}

define_instruction(not) {
  ac = bool_obj(ac == 0);
  gonexti();
}

define_instruction(izerop) {
  cki(ac);
  ac = bool_obj(ac == fixnum_obj(0));
  gonexti();
}

define_instruction(iposp) {
  cki(ac);
  ac = bool_obj(get_fixnum(ac) > 0);
  gonexti(); 
}

define_instruction(inegp) {
  cki(ac);
  ac = bool_obj(get_fixnum(ac) < 0);
  gonexti(); 
}

define_instruction(ievnp) {
  cki(ac);
  ac = bool_obj((get_fixnum(ac) & 1) == 0);
  gonexti(); 
}

define_instruction(ioddp) {
  cki(ac);
  ac = bool_obj((get_fixnum(ac) & 1) != 0);
  gonexti(); 
}

define_instruction(iadd) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = fixnum_obj(fxadd(get_fixnum(x), get_fixnum(y)));
  gonexti(); 
}

define_instruction(isub) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = fixnum_obj(fxsub(get_fixnum(x), get_fixnum(y)));
  gonexti(); 
}

define_instruction(imul) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = fixnum_obj(fxmul(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(iquo) {
  obj x = ac, y = spop(); cki(x); cki(y);
  if (y == fixnum_obj(0)) fail("division by zero");
  ac = fixnum_obj(fxquo(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(irem) {
  obj x = ac, y = spop(); cki(x); cki(y);
  if (y == fixnum_obj(0)) fail("division by zero");
  ac = fixnum_obj(fxrem(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(imin) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = get_fixnum(x) < get_fixnum(y) ? x : y;
  gonexti(); 
}

define_instruction(imax) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = get_fixnum(x) > get_fixnum(y) ? x : y;
  gonexti(); 
}

define_instruction(ineg) {
  cki(ac);
  ac = fixnum_obj(fxneg(get_fixnum(ac)));
  gonexti();
}

define_instruction(iabs) {
  cki(ac);
  ac = fixnum_obj(fxabs(get_fixnum(ac)));
  gonexti();
}

define_instruction(itoj) {
  cki(ac);
  ac = flonum_obj((double)get_fixnum(ac));
  gonexti();
}

define_instruction(idiv) {
  obj x = ac, y = spop(); cki(x); cki(y);
  if (y == fixnum_obj(0)) fail("division by zero");
  ac = fixnum_obj(fxdiv(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(imqu) {
  obj x = ac, y = spop(); cki(x); cki(y);
  if (y == fixnum_obj(0)) fail("division by zero");
  ac = fixnum_obj(fxmqu(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(imlo) {
  obj x = ac, y = spop(); cki(x); cki(y);
  if (y == fixnum_obj(0)) fail("division by zero");
  ac = fixnum_obj(fxmlo(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(ieuq) {
  obj x = ac, y = spop(); cki(x); cki(y);
  if (y == fixnum_obj(0)) fail("division by zero");
  ac = fixnum_obj(fxeuq(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(ieur) {
  obj x = ac, y = spop(); cki(x); cki(y);
  if (y == fixnum_obj(0)) fail("division by zero");
  ac = fixnum_obj(fxeur(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(igcd) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = fixnum_obj(fxgcd(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(ipow) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = fixnum_obj(fxpow(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(isqrt) {
  cki(ac); /* TODO: check for negative */
  ac = fixnum_obj(fxsqrt(get_fixnum(ac)));
  gonexti();
}

define_instruction(inot) {
  cki(ac);
  ac = fixnum_obj(~get_fixnum(ac));
  gonexti();
}

define_instruction(iand) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = fixnum_obj(get_fixnum(x) & get_fixnum(y));
  gonexti();
}

define_instruction(iior) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = fixnum_obj(get_fixnum(x) | get_fixnum(y));
  gonexti();
}

define_instruction(ixor) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = fixnum_obj(get_fixnum(x) ^ get_fixnum(y));
  gonexti();
}

define_instruction(iasl) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = fixnum_obj(fxasl(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(iasr) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = fixnum_obj(fxasr(get_fixnum(x), get_fixnum(y)));
  gonexti();
}

define_instruction(ilt) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = bool_obj(get_fixnum(x) < get_fixnum(y));
  gonexti(); 
}

define_instruction(igt) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = bool_obj(get_fixnum(x) > get_fixnum(y));
  gonexti(); 
}

define_instruction(ile) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = bool_obj(get_fixnum(x) <= get_fixnum(y));
  gonexti(); 
}

define_instruction(ige) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = bool_obj(get_fixnum(x) >= get_fixnum(y));
  gonexti(); 
}

define_instruction(ieq) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = bool_obj(x == y);
  gonexti(); 
}

define_instruction(ine) {
  obj x = ac, y = spop(); cki(x); cki(y);
  ac = bool_obj(x != y);
  gonexti(); 
}


define_instruction(jzerop) {
  ckj(ac);
  ac = bool_obj(get_flonum(ac) == 0.0);
  gonexti();
}

define_instruction(jposp) {
  ckj(ac);
  ac = bool_obj(get_flonum(ac) > 0.0);
  gonexti(); 
}

define_instruction(jnegp) {
  ckj(ac);
  ac = bool_obj(get_flonum(ac) < 0.0);
  gonexti(); 
}

define_instruction(jevnp) {
  double f; ckj(ac);
  f = get_flonum(ac);
  ac = bool_obj(flisint(f / 2.0));
  gonexti(); 
}

define_instruction(joddp) {
  double f; ckj(ac);
  f = get_flonum(ac);
  ac = bool_obj(flisint((f + 1.0) / 2.0));
  gonexti(); 
}

define_instruction(jintp) {
  double f; ckj(ac);
  f = get_flonum(ac);
  ac = bool_obj(f > -HUGE_VAL && f < HUGE_VAL && f == floor(f));
  gonexti(); 
}

define_instruction(jnanp) {
  double f; ckj(ac);
  f = get_flonum(ac);
  ac = bool_obj(f != f);
  gonexti(); 
}

define_instruction(jfinp) {
  double f; ckj(ac);
  f = get_flonum(ac);
  ac = bool_obj(f > -HUGE_VAL && f < HUGE_VAL);
  gonexti(); 
}

define_instruction(jinfp) {
  double f; ckj(ac);
  f = get_flonum(ac);
  ac = bool_obj(f <= -HUGE_VAL || f >= HUGE_VAL);
  gonexti(); 
}

define_instruction(jadd) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = flonum_obj(get_flonum(x) + get_flonum(y));
  gonexti(); 
}

define_instruction(jsub) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = flonum_obj(get_flonum(x) - get_flonum(y));
  gonexti(); 
}

define_instruction(jmul) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = flonum_obj(get_flonum(x) * get_flonum(y));
  gonexti();
}

define_instruction(jdiv) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = flonum_obj(get_flonum(x) / get_flonum(y));
  gonexti();
}

define_instruction(jlt) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = bool_obj(get_flonum(x) < get_flonum(y));
  gonexti(); 
}

define_instruction(jgt) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = bool_obj(get_flonum(x) > get_flonum(y));
  gonexti(); 
}

define_instruction(jle) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = bool_obj(get_flonum(x) <= get_flonum(y));
  gonexti(); 
}

define_instruction(jge) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = bool_obj(get_flonum(x) >= get_flonum(y));
  gonexti(); 
}

define_instruction(jeq) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = bool_obj(get_flonum(x) == get_flonum(y));
  gonexti(); 
}

define_instruction(jne) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = bool_obj(get_flonum(x) != get_flonum(y));
  gonexti(); 
}

define_instruction(jmin) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = get_flonum(x) < get_flonum(y) ? x : y;
  gonexti(); 
}

define_instruction(jmax) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = get_flonum(x) > get_flonum(y) ? x : y;
  gonexti(); 
}

define_instruction(jneg) {
  ckj(ac);
  ac = flonum_obj(-get_flonum(ac));
  gonexti(); 
}

define_instruction(jabs) {
  ckj(ac);
  ac = flonum_obj(fabs(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jgcd) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = flonum_obj(flgcd(get_flonum(x), get_flonum(y)));
  gonexti(); 
}

define_instruction(jpow) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = flonum_obj(pow(get_flonum(x), get_flonum(y)));
  gonexti(); 
}

define_instruction(jsqrt) {
  ckj(ac);
  ac = flonum_obj(sqrt(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jtoi) {
  ckj(ac);
  ac = fixnum_obj(fxflo(get_flonum(ac)));
  gonexti();
}

define_instruction(jquo) {
  obj x = ac, y = spop(); double n, d, i; 
  ckj(x); ckj(y);
  n = get_flonum(x), d = get_flonum(y); modf(n/d,  &i);
  ac = flonum_obj(i);
  gonexti(); 
}

define_instruction(jrem) {
  /* NB: we keep sign: (flremainder -10.0 2.0) => -0.0 */
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = flonum_obj(fmod(get_flonum(x), get_flonum(y)));
  gonexti();
}


define_instruction(jmqu) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = flonum_obj(flmqu(get_flonum(x), get_flonum(y)));
  gonexti(); 
}

define_instruction(jmlo) {
  obj x = ac, y = spop(); ckj(x); ckj(y);
  ac = flonum_obj(flmlo(get_flonum(x), get_flonum(y)));
  gonexti(); 
}

define_instruction(jfloor) {
  ckj(ac);
  ac = flonum_obj(floor(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jceil) {
  ckj(ac);
  ac = flonum_obj(ceil(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jtrunc) {
  double i; ckj(ac);
  modf(get_flonum(ac), &i);
  ac = flonum_obj(i);
  gonexti(); 
}

define_instruction(jround) {
  ckj(ac);
  ac = flonum_obj(flround(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jexp) {
  ckj(ac);
  ac = flonum_obj(exp(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jlog) {
  obj x = ac, y = spop(); ckj(ac);
  if (likely(!y)) {
    ac = flonum_obj(log(get_flonum(ac)));
  } else {
    double b; ckj(y); b = get_flonum(y);
    if (likely(b == 10.0)) ac = flonum_obj(log10(get_flonum(ac)));
    else ac = flonum_obj(log(get_flonum(ac))/log(b));
  }
  gonexti(); 
}

define_instruction(jsin) {
  ckj(ac);
  ac = flonum_obj(sin(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jcos) {
  ckj(ac);
  ac = flonum_obj(cos(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jtan) {
  ckj(ac);
  ac = flonum_obj(tan(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jasin) {
  ckj(ac);
  ac = flonum_obj(asin(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jacos) {
  ckj(ac);
  ac = flonum_obj(acos(get_flonum(ac)));
  gonexti(); 
}

define_instruction(jatan) {
  obj x = ac, y = spop(); ckj(ac);
  if (likely(!y)) {
    ac = flonum_obj(atan(get_flonum(x)));
  } else {
    ckj(y); 
    ac = flonum_obj(atan2(get_flonum(x), get_flonum(y)));
  }
  gonexti(); 
}


define_instruction(zerop) {
  obj x = ac;
  if (likely(is_fixnum(x))) {
    ac = bool_obj(x == fixnum_obj(0));
  } else if (likely(is_flonum(x))) {
    ac = bool_obj(get_flonum(x) == 0.0);
  } else failactype("number");
  gonexti();
}

define_instruction(posp) {
  if (likely(is_fixnum(ac))) ac = bool_obj(get_fixnum(ac) > 0);
  else if (likely(is_flonum(ac))) ac = bool_obj(get_flonum(ac) > 0.0);
  else failactype("number");
  gonexti(); 
}

define_instruction(negp) {
  if (likely(is_fixnum(ac))) ac = bool_obj(get_fixnum(ac) < 0);
  else if (likely(is_flonum(ac))) ac = bool_obj(get_flonum(ac) < 0.0);
  else failactype("number");
  gonexti(); 
}

define_instruction(add) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    long lx = get_fixnum(x), ly = get_fixnum(y);   
    long long llz = (long long)lx + (long long)ly;
    if (likely(llz >= FIXNUM_MIN && llz <= FIXNUM_MAX)) ac = fixnum_obj((long)llz);
    else ac = flonum_obj((double)lx + (double)ly);
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = flonum_obj(dx + dy);
  }
  gonexti(); 
}

define_instruction(sub) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    long lx = get_fixnum(x), ly = get_fixnum(y);   
    long long llz = (long long)lx - (long long)ly;
    if (likely(llz >= FIXNUM_MIN && llz <= FIXNUM_MAX)) ac = fixnum_obj((long)llz);
    else ac = flonum_obj((double)lx - (double)ly);
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = flonum_obj(dx - dy);
  }
  gonexti(); 
}

define_instruction(mul) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    long lx = get_fixnum(x), ly = get_fixnum(y);   
    long long llz = (long long)lx * (long long)ly;
    if (likely(llz >= FIXNUM_MIN && llz <= FIXNUM_MAX)) ac = fixnum_obj((long)llz);
    else ac = flonum_obj((double)lx * (double)ly);
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = flonum_obj(dx * dy);
  }
  gonexti(); 
}

define_instruction(div) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    long lx, ly; long long llz, llr;
    if (unlikely(y == fixnum_obj(0))) fail("division by zero");
    lx = get_fixnum(x), ly = get_fixnum(y);   
    llz = (long long)lx / (long long)ly, llr = (long long)lx % (long long)ly;
    if (likely(!llr && llz >= FIXNUM_MIN && llz <= FIXNUM_MAX)) ac = fixnum_obj((long)llz);
    else ac = flonum_obj((double)lx / (double)ly);
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = flonum_obj(dx / dy);
  }
  gonexti(); 
}

define_instruction(quo) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    if (unlikely(y == fixnum_obj(0))) fail("division by zero");
    ac = fixnum_obj(fxquo(get_fixnum(x), get_fixnum(y)));
  } else {
    double dx, dy, dz;
    if (likely(is_flonum(x) && flisint(dx = get_flonum(x)))) /* ok */;
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "integer");
    if (likely(is_flonum(y) && flisint(dy = get_flonum(y)))) /* ok */;
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "integer");
    modf(dx / dy,  &dz);
    ac = flonum_obj(dz);
  }
  gonexti(); 
}

define_instruction(rem) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    if (unlikely(y == fixnum_obj(0))) fail("division by zero");
    ac = fixnum_obj(fxrem(get_fixnum(x), get_fixnum(y)));
  } else {
    double dx, dy, dz;
    if (likely(is_flonum(x) && flisint(dx = get_flonum(x)))) /* ok */;
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "integer");
    if (likely(is_flonum(y) && flisint(dy = get_flonum(y)))) /* ok */;
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "integer");
    dz = fmod(dx, dy);
    /* keep zero positive: (remainder -10.0 2.0) => 0.0, not -0.0 */
    ac = flonum_obj((dz == 0.0) ? 0.0 : dz);
  }
  gonexti(); 
}

define_instruction(mqu) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    if (unlikely(y == fixnum_obj(0))) fail("division by zero");
    ac = fixnum_obj(fxmqu(get_fixnum(x), get_fixnum(y)));
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = flonum_obj(flmqu(dx, dy));
  }
  gonexti(); 
}

define_instruction(mlo) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    if (unlikely(y == fixnum_obj(0))) fail("division by zero");
    ac = fixnum_obj(fxmlo(get_fixnum(x), get_fixnum(y)));
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = flonum_obj(flmlo(dx, dy));
  }
  gonexti(); 
}


define_instruction(lt) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    ac = bool_obj(get_fixnum(x) < get_fixnum(y));
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = bool_obj(dx < dy);
  }
  gonexti(); 
}

define_instruction(gt) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    ac = bool_obj(get_fixnum(x) > get_fixnum(y));
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = bool_obj(dx > dy);
  }
  gonexti(); 
}

define_instruction(le) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    ac = bool_obj(get_fixnum(x) <= get_fixnum(y));
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = bool_obj(dx <= dy);
  }
  gonexti(); 
}

define_instruction(ge) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    ac = bool_obj(get_fixnum(x) >= get_fixnum(y));
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = bool_obj(dx >= dy);
  }
  gonexti(); 
}

define_instruction(eq) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    ac = bool_obj(x == y);
  } else if (is_flonum(x) || is_flonum(y)) {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = bool_obj(dx == dy);
  } else ac = bool_obj(0);
  gonexti(); 
}

define_instruction(ne) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    ac = bool_obj(x != y);
  } else if (is_flonum(x) || is_flonum(y)) {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = bool_obj(dx != dy);
  } else ac = bool_obj(1);
  gonexti(); 
}

define_instruction(min) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    ac = (get_fixnum(x) < get_fixnum(y)) ? x : y;
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = dx < dy ? flonum_obj(dx) : flonum_obj(dy);
  }
  gonexti(); 
}

define_instruction(max) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    ac = (get_fixnum(x) > get_fixnum(y)) ? x : y;
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = dx > dy ? flonum_obj(dx) : flonum_obj(dy);
  }
  gonexti(); 
}

define_instruction(gcd) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    ac = fixnum_obj(fxgcd(get_fixnum(x), get_fixnum(y)));
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = flonum_obj(flgcd(dx, dy));
  }
  gonexti(); 
}

define_instruction(pow) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    /* fixme: this will either overflow, or fail on negative y */
    ac = fixnum_obj(fxpow(get_fixnum(x), get_fixnum(y)));
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = flonum_obj(pow(dx, dy));
  }
  gonexti(); 
}

define_instruction(sqrt) {
  if (likely(is_flonum(ac))) {
    ac = flonum_obj(sqrt(get_flonum(ac)));
  } else if (likely(is_fixnum(ac))) {
    long x = get_fixnum(ac), y;
    if (x < 0) ac = flonum_obj((HUGE_VAL - HUGE_VAL));   
    else if (y = fxsqrt(x), y*y == x) ac = fixnum_obj(y);
    else ac = flonum_obj(sqrt((double)x));
  } else failactype("number");
  gonexti(); 
}

define_instruction(exp) {
  double x;
  if (unlikely(is_fixnum(ac))) x = (double)get_fixnum(ac);
  else if (likely(is_flonum(ac))) x = get_flonum(ac);
  else failactype("number");
  ac = flonum_obj(exp(x));
  gonexti(); 
}

define_instruction(log) {
  double x; obj y = spop();
  if (unlikely(is_fixnum(ac))) x = (double)get_fixnum(ac);
  else if (likely(is_flonum(ac))) x = get_flonum(ac);
  else failactype("number");
  if (likely(!y)) {
    ac = flonum_obj(log(x));
  } else if (likely(y == fixnum_obj(10))) {
    ac = flonum_obj(log10(x));
  } else {
    double b; 
    if (unlikely(is_fixnum(y))) b = (double)get_fixnum(y);
    else if (likely(is_flonum(y))) b = get_flonum(y);
    else failtype(y, "number");
    if (likely(b == 10.0)) ac = flonum_obj(log10(x));
    else ac = flonum_obj(log(x)/log(b));
  }
  gonexti(); 
}

define_instruction(sin) {
  double x;
  if (unlikely(is_fixnum(ac))) {
    x = (double)get_fixnum(ac);
  } else if (likely(is_flonum(ac))) {
    x = get_flonum(ac);
  } else failactype("number");
  ac = flonum_obj(sin(x));
  gonexti(); 
}

define_instruction(cos) {
  double x;
  if (unlikely(is_fixnum(ac))) {
    x = (double)get_fixnum(ac);
  } else if (likely(is_flonum(ac))) {
    x = get_flonum(ac);
  } else failactype("number");
  ac = flonum_obj(cos(x));
  gonexti(); 
}

define_instruction(tan) {
  double x;
  if (unlikely(is_fixnum(ac))) {
    x = (double)get_fixnum(ac);
  } else if (likely(is_flonum(ac))) {
    x = get_flonum(ac);
  } else failactype("number");
  ac = flonum_obj(tan(x));
  gonexti(); 
}

define_instruction(asin) {
  double x;
  if (unlikely(is_fixnum(ac))) {
    x = (double)get_fixnum(ac);
  } else if (likely(is_flonum(ac))) {
    x = get_flonum(ac);
  } else failactype("number");
  ac = flonum_obj(asin(x));
  gonexti(); 
}

define_instruction(acos) {
  double x;
  if (unlikely(is_fixnum(ac))) {
    x = (double)get_fixnum(ac);
  } else if (likely(is_flonum(ac))) {
    x = get_flonum(ac);
  } else failactype("number");
  ac = flonum_obj(acos(x));
  gonexti(); 
}

define_instruction(atan) {
  double x; obj y = spop();
  if (unlikely(is_fixnum(ac))) x = (double)get_fixnum(ac);
  else if (likely(is_flonum(ac))) x = get_flonum(ac);
  else failactype("number");
  if (likely(!y)) {
    ac = flonum_obj(atan(x));
  } else {
    double b; 
    if (unlikely(is_fixnum(y))) b = (double)get_fixnum(y);
    else if (likely(is_flonum(y))) b = get_flonum(y);
    else failtype(y, "number");
    ac = flonum_obj(atan2(x, b));
  }
  gonexti(); 
}

define_instruction(neg) {
  if (likely(is_fixnum(ac))) {
    ac = fixnum_obj(-get_fixnum(ac));
  } else if (likely(is_flonum(ac))) {
    ac = flonum_obj(-get_flonum(ac));
  } else failactype("number");
  gonexti(); 
}

define_instruction(abs) {
  if (likely(is_fixnum(ac))) {
    ac = fixnum_obj(fxabs(get_fixnum(ac)));
  } else if (likely(is_flonum(ac))) {
    ac = flonum_obj(fabs(get_flonum(ac)));
  } else failactype("number");
  gonexti(); 
}

define_instruction(floor) {
  if (likely(is_flonum(ac))) {
    ac = flonum_obj(floor(get_flonum(ac)));
  } else if (unlikely(!is_fixnum(ac))) {
    failactype("number");
  }
  gonexti(); 
}

define_instruction(ceil) {
  if (likely(is_flonum(ac))) {
    ac = flonum_obj(ceil(get_flonum(ac)));
  } else if (unlikely(!is_fixnum(ac))) {
    failactype("number");
  }
  gonexti(); 
}

define_instruction(trunc) {
  if (likely(is_flonum(ac))) {
    double x = get_flonum(ac);
    double i; modf(x,  &i);
    ac = flonum_obj(i);
  } else if (unlikely(!is_fixnum(ac))) {
    failactype("number");
  }
  gonexti(); 
}

define_instruction(round) {
  if (likely(is_flonum(ac))) {
    ac = flonum_obj(flround(get_flonum(ac)));
  } else if (unlikely(!is_fixnum(ac))) {
    failactype("number");
  }
  gonexti(); 
}


define_instruction(nump) {
  ac = bool_obj(is_fixnum(ac) || is_flonum(ac));
  gonexti(); 
}

define_instruction(fixp) {
  ac = bool_obj(is_fixnum(ac));
  gonexti(); 
}

define_instruction(flop) {
  ac = bool_obj(is_flonum(ac));
  gonexti(); 
}

define_instruction(intp) {
  if (likely(is_fixnum(ac))) {
    ac = bool_obj(1);
  } else { /* accepts any object! */
    ac = bool_obj(is_flonum(ac) && flisint(get_flonum(ac)));
  }
  gonexti(); 
}

define_instruction(ratp) {
  if (likely(is_fixnum(ac))) {
    ac = bool_obj(1);
  } else if (likely(is_flonum(ac))) {
    double f = get_flonum(ac);
    ac = bool_obj(f > -HUGE_VAL && f < HUGE_VAL);
  } else {
    ac = bool_obj(0);
  }
  gonexti(); 
}


define_instruction(nanp) {
  if (unlikely(is_fixnum(ac))) {
    ac = bool_obj(0);
  } else if (likely(is_flonum(ac))) {
    double f = get_flonum(ac);
    ac = bool_obj(f != f);
  } else failactype("number");
  gonexti(); 
}

define_instruction(finp) {
  if (unlikely(is_fixnum(ac))) {
    ac = bool_obj(1);
  } else if (likely(is_flonum(ac))) {
    double f = get_flonum(ac);
    ac = bool_obj(f > -HUGE_VAL && f < HUGE_VAL);
  } else failactype("number");
  gonexti(); 
}

define_instruction(infp) {
  if (unlikely(is_fixnum(ac))) {
    ac = bool_obj(0);
  } else if (likely(is_flonum(ac))) {
    double f = get_flonum(ac);
    ac = bool_obj(f <= -HUGE_VAL || f >= HUGE_VAL);
  } else failactype("number");
  gonexti(); 
}

define_instruction(evnp) {
  if (likely(is_fixnum(ac))) {
    ac = bool_obj((get_fixnum(ac) & 1) == 0);
  } else if (likely(is_flonum(ac))) {
    double f = get_flonum(ac);
    ac = bool_obj(flisint(f / 2.0));
  } else failactype("number");
  gonexti(); 
}

define_instruction(oddp) {
  if (likely(is_fixnum(ac))) {
    ac = bool_obj((get_fixnum(ac) & 1) != 0);
  } else if (likely(is_flonum(ac))) {
    double f = get_flonum(ac);
    ac = bool_obj(flisint((f + 1.0) / 2.0));
  } else failactype("number");
  gonexti(); 
}

define_instruction(ntoi) {
  if (likely(is_flonum(ac))) ac = fixnum_obj(fxflo(get_flonum(ac)));
  else if (likely(is_fixnum(ac))) /* keep ac as-is */ ;
  else failactype("number");
  gonexti(); 
}

define_instruction(ntoj) {
  if (likely(is_fixnum(ac))) ac = flonum_obj((flonum_t)get_fixnum(ac));
  else if (likely(is_flonum(ac))) /* keep ac as-is */ ;
  else failactype("number");
  gonexti(); 
}


define_instruction(lcat) {
  obj t, l, *p, *d; int c;
  for (l = ac, c = 0; is_pair(l); l = pair_cdr(l)) ++c;
  hp_reserve(pairbsz()*c);
  p = --sp; t = *p; /* pop & take addr */
  for (l = ac; is_pair(l); l = pair_cdr(l)) {
    *--hp = t; d = hp; *--hp = pair_car(l);
    *p = hend_pair(); p = d;
  }
  ac = *sp;
  gonexti(); 
}

define_instruction(lcpy) {
  obj t, l, *p, *d; int c;
  for (l = ac, c = 0; is_pair(l); l = pair_cdr(l)) ++c;
  hp_reserve(pairbsz()*c);
  p = sp; *p = t = l; /* tail of last pair */
  for (l = ac; is_pair(l); l = pair_cdr(l)) {
    *--hp = t; d = hp; *--hp = pair_car(l);
    *p = hend_pair(); p = d;
  }
  ac = *sp;
  gonexti(); 
}

define_instruction(ccmp) {
  obj x = ac, y = spop(); int cmp; ckc(x); ckc(y);
  cmp = get_char(x) - get_char(y);
  ac = fixnum_obj(cmp);
  gonexti(); 
}

define_instruction(ceq) {
  obj x = ac, y = spop(); ckc(x); ckc(y);
  ac = bool_obj(get_char(x) == get_char(y));
  gonexti(); 
}

define_instruction(clt) {
  obj x = ac, y = spop(); ckc(x); ckc(y);
  ac = bool_obj(get_char(x) < get_char(y));
  gonexti(); 
}

define_instruction(cgt) {
  obj x = ac, y = spop(); ckc(x); ckc(y);
  ac = bool_obj(get_char(x) > get_char(y));
  gonexti(); 
}

define_instruction(cle) {
  obj x = ac, y = spop(); ckc(x); ckc(y);
  ac = bool_obj(get_char(x) <= get_char(y));
  gonexti(); 
}

define_instruction(cge) {
  obj x = ac, y = spop(); ckc(x); ckc(y);
  ac = bool_obj(get_char(x) >= get_char(y));
  gonexti(); 
}

define_instruction(cicmp) {
  obj x = ac, y = spop(); int cmp; ckc(x); ckc(y);
  cmp = tolower(get_char(x)) - tolower(get_char(y));
  ac = fixnum_obj(cmp);
  gonexti(); 
}

define_instruction(cieq) {
  obj x = ac, y = spop(); ckc(x); ckc(y);
  ac = bool_obj(tolower(get_char(x)) == tolower(get_char(y)));
  gonexti(); 
}

define_instruction(cilt) {
  obj x = ac, y = spop(); ckc(x); ckc(y);
  ac = bool_obj(tolower(get_char(x)) < tolower(get_char(y)));
  gonexti(); 
}

define_instruction(cigt) {
  obj x = ac, y = spop(); ckc(x); ckc(y);
  ac = bool_obj(tolower(get_char(x)) > tolower(get_char(y)));
  gonexti(); 
}

define_instruction(cile) {
  obj x = ac, y = spop(); ckc(x); ckc(y);
  ac = bool_obj(tolower(get_char(x)) <= tolower(get_char(y)));
  gonexti(); 
}

define_instruction(cige) {
  obj x = ac, y = spop(); ckc(x); ckc(y);
  ac = bool_obj(tolower(get_char(x)) >= tolower(get_char(y)));
  gonexti(); 
}

define_instruction(cwsp) {
  ckc(ac);
  ac = bool_obj(isspace(get_char(ac)));
  gonexti(); 
}

define_instruction(clcp) {
  ckc(ac);
  ac = bool_obj(islower(get_char(ac)));
  gonexti(); 
}

define_instruction(cucp) {
  ckc(ac);
  ac = bool_obj(isupper(get_char(ac)));
  gonexti(); 
}

define_instruction(calp) {
  ckc(ac);
  ac = bool_obj(isalpha(get_char(ac)));
  gonexti(); 
}

define_instruction(cnup) {
  ckc(ac);
  ac = bool_obj(isdigit(get_char(ac)));
  gonexti(); 
}

define_instruction(cupc) {
  ckc(ac);
  ac = char_obj(toupper(get_char(ac)));
  gonexti(); 
}

define_instruction(cdnc) {
  ckc(ac);
  ac = char_obj(tolower(get_char(ac)));
  gonexti(); 
}

define_instruction(cflc) {
  ckc(ac);
  ac = char_obj(tolower(get_char(ac))); /* stub */
  gonexti(); 
}

define_instruction(cdgv) {
  int ch; ckc(ac);
  ch = get_char(ac);
  if (likely('0' <= ch && ch <= '9')) ac = fixnum_obj(ch - '0');  
  /* R7RS won't allow hex and any larger radix digits
  else if (likely('a' <= ch && ch <= 'z')) ac = fixnum_obj(10 + ch - 'a');  
  else if (likely('A' <= ch && ch <= 'Z')) ac = fixnum_obj(10 + ch - 'A'); */
  else ac = bool_obj(0);
  gonexti(); 
}


define_instruction(scmp) {
  obj x = ac, y = spop(); int cmp; cks(x); cks(y);
  cmp = strcmp(stringchars(x), stringchars(y));
  ac = fixnum_obj(cmp);
  gonexti(); 
}

define_instruction(seq) {
  obj x = ac, y = spop(); cks(x); cks(y);
  ac = bool_obj(strcmp(stringchars(x), stringchars(y)) == 0);
  gonexti(); 
}

define_instruction(slt) {
  obj x = ac, y = spop(); cks(x); cks(y);
  ac = bool_obj(strcmp(stringchars(x), stringchars(y)) < 0);
  gonexti(); 
}

define_instruction(sgt) {
  obj x = ac, y = spop(); cks(x); cks(y);
  ac = bool_obj(strcmp(stringchars(x), stringchars(y)) > 0);
  gonexti(); 
}

define_instruction(sle) {
  obj x = ac, y = spop(); cks(x); cks(y);
  ac = bool_obj(strcmp(stringchars(x), stringchars(y)) <= 0);
  gonexti(); 
}

define_instruction(sge) {
  obj x = ac, y = spop(); cks(x); cks(y);
  ac = bool_obj(strcmp(stringchars(x), stringchars(y)) >= 0);
  gonexti(); 
}

define_instruction(sicmp) {
  obj x = ac, y = spop(); int cmp; cks(x); cks(y);
  cmp = strcmp_ci(stringchars(x), stringchars(y));
  ac = fixnum_obj(cmp);
  gonexti(); 
}

define_instruction(sieq) {
  obj x = ac, y = spop(); cks(x); cks(y);
  ac = bool_obj(strcmp_ci(stringchars(x), stringchars(y)) == 0);
  gonexti(); 
}

define_instruction(silt) {
  obj x = ac, y = spop(); cks(x); cks(y);
  ac = bool_obj(strcmp_ci(stringchars(x), stringchars(y)) < 0);
  gonexti(); 
}

define_instruction(sigt) {
  obj x = ac, y = spop(); cks(x); cks(y);
  ac = bool_obj(strcmp_ci(stringchars(x), stringchars(y)) > 0);
  gonexti(); 
}

define_instruction(sile) {
  obj x = ac, y = spop(); cks(x); cks(y);
  ac = bool_obj(strcmp_ci(stringchars(x), stringchars(y)) <= 0);
  gonexti(); 
}

define_instruction(sige) {
  obj x = ac, y = spop(); cks(x); cks(y);
  ac = bool_obj(strcmp_ci(stringchars(x), stringchars(y)) >= 0);
  gonexti(); 
}


define_instruction(symp) {
  ac = bool_obj(is_symbol(ac));
  gonexti();
}

define_instruction(boolp) {
  ac = bool_obj(is_bool(ac));
  gonexti();
}

define_instruction(boxp) {
  ac = bool_obj(is_box(ac));
  gonexti();
}

define_instruction(funp) {
  ac = bool_obj(is_proc(ac));
  gonexti();
}

define_instruction(voidp) {
  ac = bool_obj(is_void(ac));
  gonexti();
}

define_instruction(void) {
  ac = void_obj();
  gonexti();
}

define_instruction(ipp) {
  ac = bool_obj(is_iport(ac));
  gonexti();
}

define_instruction(opp) {
  ac = bool_obj(is_oport(ac));
  gonexti();
}

define_instruction(cin) {
  ac = cx__2Acurrent_2Dinput_2A;
  assert(is_iport(ac));
  gonexti();
}

define_instruction(cout) {
  ac = cx__2Acurrent_2Doutput_2A;
  assert(is_oport(ac));
  gonexti();
}

define_instruction(cerr) {
  ac = cx__2Acurrent_2Derror_2A;
  assert(is_oport(ac));
  gonexti();
}

define_instruction(setcin) {
  ckr(ac);
  cx__2Acurrent_2Dinput_2A = ac;
  gonexti();
}

define_instruction(setcout) {
  ckw(ac);
  cx__2Acurrent_2Doutput_2A = ac;
  gonexti();
}

define_instruction(setcerr) {
  ckw(ac);
  cx__2Acurrent_2Derror_2A = ac;
  gonexti();
  gonexti();
}

define_instruction(sip) {
  ac = iport_file_obj(stdin);
  gonexti();
}

define_instruction(sop) {
  ac = oport_file_obj(stdout);
  gonexti();
}

define_instruction(sep) {
  ac = oport_file_obj(stderr);
  gonexti();
}

define_instruction(ipop) {
  cxtype_iport_t *vt; ckr(ac); 
  vt = iportvt(ac); assert(vt);
  ac = bool_obj(vt != (cxtype_iport_t *)IPORT_CLOSED_NTAG);
  gonexti();
}

define_instruction(opop) {
  cxtype_oport_t *vt; ckw(ac); 
  vt = oportvt(ac); assert(vt);
  ac = bool_obj(vt != (cxtype_oport_t *)OPORT_CLOSED_NTAG);
  gonexti();
}

define_instruction(oif) {
  FILE *fp = fopen(stringchars(ac), "r");
  ac = (fp == NULL) ? bool_obj(0) : iport_file_obj(fp);
  gonexti();
}

define_instruction(oof) {
  FILE *fp = fopen(stringchars(ac), "w");
  ac = (fp == NULL) ? bool_obj(0) : oport_file_obj(fp);
  gonexti();
}

define_instruction(obif) {
  FILE *fp = fopen(stringchars(ac), "rb");
  ac = (fp == NULL) ? bool_obj(0) : iport_file_obj(fp);
  gonexti();
}

define_instruction(obof) {
  FILE *fp = fopen(stringchars(ac), "wb");
  ac = (fp == NULL) ? bool_obj(0) : oport_file_obj(fp);
  gonexti();
}

define_instruction(ois) {
  int *d; cks(ac);
  d = dupstring(stringdata(ac));
  ac = iport_string_obj(sialloc(sdatachars(d), d));
  gonexti();
}

define_instruction(oos) {
  ac = oport_string_obj(newcb());
  gonexti();
}

define_instruction(oib) {
  int *d; unsigned char *p, *e; ckb(ac);
  d = dupbytevector(bytevectordata(ac));
  p = bvdatabytes(d), e = p + *d;
  ac = iport_bytevector_obj(bvialloc(p, e, d));
  gonexti();
}

define_instruction(oob) {
  ac = oport_bytevector_obj(newcb());
  gonexti();
}

define_instruction(cip) {
  cxtype_iport_t *vt; ckr(ac);
  vt = iportvt(ac); assert(vt);
  vt->close(iportdata(ac)); vt->free(iportdata(ac));
  objptr_from_obj(ac)[-1] = (obj)IPORT_CLOSED_NTAG;
  gonexti();
}

define_instruction(cop) {
  cxtype_oport_t *vt; ckw(ac);
  vt = oportvt(ac); assert(vt);
  vt->close(oportdata(ac)); vt->free(oportdata(ac));
  objptr_from_obj(ac)[-1] = (obj)OPORT_CLOSED_NTAG;
  gonexti();
}

define_instruction(fop) {
  ckw(ac);
  oportflush(ac);
  gonexti();
}

define_instruction(gos) {
  cxtype_oport_t *vt; ckw(ac);
  vt = ckoportvt(ac);
  if (vt != (cxtype_oport_t *)OPORT_STRING_NTAG &&
      vt != (cxtype_oport_t *)OPORT_BYTEVECTOR_NTAG) {
    ac = eof_obj();
  } else {
    cbuf_t *pcb = oportdata(ac);
    ac = string_obj(newstring(cbdata(pcb)));
  }
  gonexti();
}

define_instruction(gob) {
  cxtype_oport_t *vt; ckw(ac);
  vt = ckoportvt(ac);
  if (vt != (cxtype_oport_t *)OPORT_BYTEVECTOR_NTAG &&
      vt != (cxtype_oport_t *)OPORT_STRING_NTAG) {
    ac = eof_obj();
  } else {
    cbuf_t *pcb = oportdata(ac);
    int len = (int)(pcb->fill - pcb->buf);
    ac = bytevector_obj(newbytevector((unsigned char *)pcb->buf, len));
  }
  gonexti();
}

define_instruction(rdc) {
  int c; ckr(ac);
  c = iportgetc(ac);
  if (unlikely(c == EOF)) ac = eof_obj();
  else ac = char_obj(c);
  gonexti();
}

define_instruction(rdac) {
  int c; ckr(ac);
  c = iportpeekc(ac);
  if (unlikely(c == EOF)) ac = eof_obj();
  else ac = char_obj(c);
  gonexti();
}

define_instruction(rdcr) {
  ckr(ac);
  ac = bool_obj(1); /* no portable way to detect hanging? */
  gonexti();
}

define_instruction(rd8) {
  int c; ckr(ac);
  c = iportgetc(ac);
  if (unlikely(c == EOF)) ac = eof_obj();
  else ac = byte_obj(c);
  gonexti();
}

define_instruction(rda8) {
  int c; ckr(ac);
  c = iportpeekc(ac);
  if (unlikely(c == EOF)) ac = eof_obj();
  else ac = byte_obj(c);
  gonexti();
}

define_instruction(rd8r) {
  ckr(ac);
  ac = bool_obj(1); /* no portable way to detect hanging? */
  gonexti();
}


define_instruction(eofp) {
  ac = bool_obj(is_eof(ac));
  gonexti();
}

define_instruction(eof) {
  ac = eof_obj();
  gonexti();
}


define_instruction(wrc) {
  obj x = ac, y = spop(); ckc(x); ckw(y);
  oportputc(get_char(x), y);
  ac = void_obj();
  gonexti();
}

define_instruction(wrs) {
  obj x = ac, y = spop(); cks(x); ckw(y);
  oportputs(stringchars(x), y);
  ac = void_obj();
  gonexti();
}

define_instruction(wr8) {
  obj x = ac, y = spop(); ck8(x); ckw(y);
  oportputc(get_byte(x), y);
  ac = void_obj();
  gonexti();
}

define_instruction(wrb) {
  obj x = ac, y = spop(); int *d; ckb(x); ckw(y);
  d = bytevectordata(x);
  oportwrite((char *)bvdatabytes(d), *d, y);
  ac = void_obj();
  gonexti();
}

define_instruction(wrcd) {
  obj x = ac, y = spop(); ckw(y);
  oportputcircular(x, y, 1);
  ac = void_obj();
  gonexti();
}

define_instruction(wrcw) {
  obj x = ac, y = spop(); ckw(y);
  oportputcircular(x, y, 0);
  ac = void_obj();
  gonexti();
}

define_instruction(wrnl) {
  ckw(ac);
  oportputc('\n', ac);
  ac = void_obj();
  gonexti();
}

define_instruction(wrhw) {
  obj x = ac, y = spop(); ckw(y);
  oportputshared(x, y, 0);
  ac = void_obj();
  gonexti();
}

define_instruction(wriw) {
  obj x = ac, y = spop(); ckw(y);
  oportputsimple(x, y, 0);
  ac = void_obj();
  gonexti();
}

define_instruction(igp) {
  ac = bool_obj(isintegrable(ac));
  gonexti(); 
}

define_instruction(iglk) {
  struct intgtab_entry *pe; cky(ac);
  pe = lookup_integrable(get_symbol(ac));
  ac = pe ? mkintegrable(pe) : bool_obj(0);
  gonexti(); 
}

define_instruction(igty) {
  int it; ckg(ac);
  it = integrable_type(integrabledata(ac));
  ac = it ? char_obj(it) : bool_obj(0);
  gonexti(); 
}

define_instruction(iggl) {
  const char *igs; ckg(ac);
  igs = integrable_global(integrabledata(ac));
  ac = igs ? mksymbol(internsym((char*)igs)) : bool_obj(0);
  gonexti(); 
}

define_instruction(igco) {
  int n; const char *cs; ckg(ac); ckk(sref(0));
  n = get_fixnum(spop());
  cs = integrable_code(integrabledata(ac), n);
  ac = cs ? string_obj(newstring((char*)cs)) : bool_obj(0);
  gonexti(); 
}

define_instruction(rdsx) {
  cks(ac); 
  unload_ac(); /* ac->ra (string) */
  unload_ip(); /* ip->rx */
  hp = rds_stox(r, sp, hp);
  reload_ac(); /* ra->ac (sexp or eof) */
  reload_ip(); /* rx->ip */
  if (ac == eof_obj()) fail("failed to read serialized s-expression");
  gonexti(); 
}

define_instruction(rdsc) {
  cks(ac); unload_ac(); /* ac->ra (string) */
  unload_ac(); /* ac->ra (string) */
  unload_ip(); /* ip->rx */
  hp = rds_stoc(r, sp, hp);
  reload_ac(); /* ra->ac (codevec or eof) */
  reload_ip(); /* rx->ip */
  if (ac == eof_obj()) fail("failed to read serialized code");
  gonexti(); 
}

define_instruction(litf) { ac = bool_obj(0); gonexti(); }  
define_instruction(litt) { ac = bool_obj(1); gonexti(); }  
define_instruction(litn) { ac = null_obj(); gonexti(); }  
define_instruction(pushlitf) { ac = bool_obj(0); spush(ac); gonexti(); }  
define_instruction(pushlitt) { ac = bool_obj(1); spush(ac); gonexti(); }  
define_instruction(pushlitn) { ac = null_obj(); spush(ac); gonexti(); }  

define_instruction(lit0) { ac = fixnum_obj(0); gonexti(); }  
define_instruction(lit1) { ac = fixnum_obj(1); gonexti(); }  
define_instruction(lit2) { ac = fixnum_obj(2); gonexti(); }  
define_instruction(lit3) { ac = fixnum_obj(3); gonexti(); }  
define_instruction(lit4) { ac = fixnum_obj(4); gonexti(); }  
define_instruction(lit5) { ac = fixnum_obj(5); gonexti(); }  
define_instruction(lit6) { ac = fixnum_obj(6); gonexti(); }  
define_instruction(lit7) { ac = fixnum_obj(7); gonexti(); }  
define_instruction(lit8) { ac = fixnum_obj(8); gonexti(); }  
define_instruction(lit9) { ac = fixnum_obj(9); gonexti(); }  
define_instruction(pushlit0) { ac = fixnum_obj(0); spush(ac); gonexti(); }  
define_instruction(pushlit1) { ac = fixnum_obj(1); spush(ac); gonexti(); }  
define_instruction(pushlit2) { ac = fixnum_obj(2); spush(ac); gonexti(); }  
define_instruction(pushlit3) { ac = fixnum_obj(3); spush(ac); gonexti(); }  
define_instruction(pushlit4) { ac = fixnum_obj(4); spush(ac); gonexti(); }  
define_instruction(pushlit5) { ac = fixnum_obj(5); spush(ac); gonexti(); }  
define_instruction(pushlit6) { ac = fixnum_obj(6); spush(ac); gonexti(); }  
define_instruction(pushlit7) { ac = fixnum_obj(7); spush(ac); gonexti(); }  
define_instruction(pushlit8) { ac = fixnum_obj(8); spush(ac); gonexti(); }  
define_instruction(pushlit9) { ac = fixnum_obj(9); spush(ac); gonexti(); }  

define_instruction(sref0) { ac = sref(0); gonexti(); }  
define_instruction(sref1) { ac = sref(1); gonexti(); }  
define_instruction(sref2) { ac = sref(2); gonexti(); }  
define_instruction(sref3) { ac = sref(3); gonexti(); }  
define_instruction(sref4) { ac = sref(4); gonexti(); }  
define_instruction(sref5) { ac = sref(5); gonexti(); }  
define_instruction(sref6) { ac = sref(6); gonexti(); }  
define_instruction(sref7) { ac = sref(7); gonexti(); }  
define_instruction(sref8) { ac = sref(8); gonexti(); }  
define_instruction(sref9) { ac = sref(9); gonexti(); }  
define_instruction(pushsref0) { ac = sref(0); spush(ac); gonexti(); }  
define_instruction(pushsref1) { ac = sref(1); spush(ac); gonexti(); }  
define_instruction(pushsref2) { ac = sref(2); spush(ac); gonexti(); }  
define_instruction(pushsref3) { ac = sref(3); spush(ac); gonexti(); }  
define_instruction(pushsref4) { ac = sref(4); spush(ac); gonexti(); }  
define_instruction(pushsref5) { ac = sref(5); spush(ac); gonexti(); }  
define_instruction(pushsref6) { ac = sref(6); spush(ac); gonexti(); }  
define_instruction(pushsref7) { ac = sref(7); spush(ac); gonexti(); }  
define_instruction(pushsref8) { ac = sref(8); spush(ac); gonexti(); }  
define_instruction(pushsref9) { ac = sref(9); spush(ac); gonexti(); }  

define_instruction(srefi0) { ac = box_ref(sref(0)); gonexti(); }
define_instruction(srefi1) { ac = box_ref(sref(1)); gonexti(); }
define_instruction(srefi2) { ac = box_ref(sref(2)); gonexti(); }
define_instruction(srefi3) { ac = box_ref(sref(3)); gonexti(); }
define_instruction(srefi4) { ac = box_ref(sref(4)); gonexti(); }
define_instruction(pushsrefi0) { ac = box_ref(sref(0)); spush(ac); gonexti(); }
define_instruction(pushsrefi1) { ac = box_ref(sref(1)); spush(ac); gonexti(); }
define_instruction(pushsrefi2) { ac = box_ref(sref(2)); spush(ac); gonexti(); }
define_instruction(pushsrefi3) { ac = box_ref(sref(3)); spush(ac); gonexti(); }
define_instruction(pushsrefi4) { ac = box_ref(sref(4)); spush(ac); gonexti(); }

define_instruction(dref0) { ac = dref(0); gonexti(); }
define_instruction(dref1) { ac = dref(1); gonexti(); }
define_instruction(dref2) { ac = dref(2); gonexti(); }
define_instruction(dref3) { ac = dref(3); gonexti(); }
define_instruction(dref4) { ac = dref(4); gonexti(); }
define_instruction(pushdref0) { ac = dref(0); spush(ac); gonexti(); }  
define_instruction(pushdref1) { ac = dref(1); spush(ac); gonexti(); }  
define_instruction(pushdref2) { ac = dref(2); spush(ac); gonexti(); }  
define_instruction(pushdref3) { ac = dref(3); spush(ac); gonexti(); }  
define_instruction(pushdref4) { ac = dref(4); spush(ac); gonexti(); }  

define_instruction(drefi0) { ac = box_ref(dref(0)); gonexti(); }
define_instruction(drefi1) { ac = box_ref(dref(1)); gonexti(); }
define_instruction(drefi2) { ac = box_ref(dref(2)); gonexti(); }
define_instruction(drefi3) { ac = box_ref(dref(3)); gonexti(); }
define_instruction(drefi4) { ac = box_ref(dref(4)); gonexti(); }
define_instruction(pushdrefi0) { ac = box_ref(dref(0)); spush(ac); gonexti(); }
define_instruction(pushdrefi1) { ac = box_ref(dref(1)); spush(ac); gonexti(); }
define_instruction(pushdrefi2) { ac = box_ref(dref(2)); spush(ac); gonexti(); }
define_instruction(pushdrefi3) { ac = box_ref(dref(3)); spush(ac); gonexti(); }
define_instruction(pushdrefi4) { ac = box_ref(dref(4)); spush(ac); gonexti(); }

define_instruction(call0) { 
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(0); 
  callsubi(); 
}
define_instruction(call1) { 
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(1); 
  callsubi(); 
}
define_instruction(call2) { 
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(2); 
  callsubi(); 
}
define_instruction(call3) { 
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(3); 
  callsubi(); 
}
define_instruction(call4) { 
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(4); 
  callsubi(); 
}

define_instruction(sreturn1) { 
  sdrop(1); rx = spop(); rd = spop(); 
  retfromi(); 
}
define_instruction(sreturn2) { 
  sdrop(2); rx = spop(); rd = spop(); 
  retfromi(); 
}
define_instruction(sreturn3) { 
  sdrop(3); rx = spop(); rd = spop(); 
  retfromi(); 
}
define_instruction(sreturn4) { 
  sdrop(4); rx = spop(); rd = spop(); 
  retfromi(); 
}

define_instruction(atest0) {
  if (unlikely(ac != fixnum_obj(0))) fail("argument count error on entry");
  gonexti();
}

define_instruction(atest1) {
  if (unlikely(ac != fixnum_obj(1))) fail("argument count error on entry");
  gonexti();
}

define_instruction(atest2) {
  if (unlikely(ac != fixnum_obj(2))) fail("argument count error on entry");
  gonexti();
}

define_instruction(atest3) {
  if (unlikely(ac != fixnum_obj(3))) fail("argument count error on entry");
  gonexti();
}

define_instruction(atest4) {
  if (unlikely(ac != fixnum_obj(4))) fail("argument count error on entry");
  gonexti();
}

define_instruction(scall1) {
  int m = 1, n = get_fixnum(*ip++);
  ckx(ac); rd = ac; rx = fixnum_obj(0); 
  ac = fixnum_obj(n); /* argc */
  objmove_left(sp-n-m, sp-n, n);
  sdrop(m); callsubi();
}

define_instruction(scall10) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(0);
  sdrop(1); callsubi();
}

define_instruction(scall11) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(1);
  sref(1) = sref(0);
  sdrop(1); callsubi();
}

define_instruction(scall12) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(2);
  sref(2) = sref(1); sref(1) = sref(0);
  sdrop(1); callsubi();
}

define_instruction(scall13) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(3);
  sref(3) = sref(2); sref(2) = sref(1); sref(1) = sref(0);
  sdrop(1); callsubi();
}

define_instruction(scall14) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(4);
  sref(4) = sref(3); sref(3) = sref(2); sref(2) = sref(1); sref(1) = sref(0);
  sdrop(1); callsubi();
}

define_instruction(scall2) {
  int m = 2, n = get_fixnum(*ip++);
  ckx(ac); rd = ac; rx = fixnum_obj(0); 
  ac = fixnum_obj(n);
  objmove_left(sp-n-m, sp-n, n);
  sdrop(m); callsubi();
}

define_instruction(scall20) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(0);
  sdrop(2); callsubi();
}

define_instruction(scall21) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(1);
  sref(2) = sref(0);
  sdrop(2); callsubi();
}

define_instruction(scall22) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(2);
  sref(3) = sref(1); sref(2) = sref(0);
  sdrop(2); callsubi();
}

define_instruction(scall23) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(3);
  sref(4) = sref(2); sref(3) = sref(1); sref(2) = sref(0);
  sdrop(2); callsubi();
}

define_instruction(scall24) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(4);
  sref(5) = sref(3); sref(4) = sref(2); sref(3) = sref(1); sref(2) = sref(0);
  sdrop(2); callsubi();
}

define_instruction(scall3) {
  int m = 3, n = get_fixnum(*ip++);
  ckx(ac); rd = ac; rx = fixnum_obj(0); 
  ac = fixnum_obj(n);
  objmove_left(sp-n-m, sp-n, n);
  sdrop(m); callsubi();
}

define_instruction(scall30) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(0);
  sdrop(3); callsubi();
}

define_instruction(scall31) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(1);
  sref(3) = sref(0);
  sdrop(3); callsubi();
}

define_instruction(scall32) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(2);
  sref(4) = sref(1); sref(3) = sref(0);
  sdrop(3); callsubi();
}

define_instruction(scall33) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(3);
  sref(5) = sref(2); sref(4) = sref(1); sref(3) = sref(0);
  sdrop(3); callsubi();
}

define_instruction(scall34) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(4);
  sref(6) = sref(3); sref(5) = sref(2); sref(4) = sref(1); sref(3) = sref(0);
  sdrop(3); callsubi();
}

define_instruction(scall4) {
  int m = 4, n = get_fixnum(*ip++);
  ckx(ac); rd = ac; rx = fixnum_obj(0); 
  ac = fixnum_obj(n);
  objmove_left(sp-n-m, sp-n, n);
  sdrop(m); callsubi();
}

define_instruction(scall40) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(0);
  sdrop(4); callsubi();
}

define_instruction(scall41) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(1);
  sref(4) = sref(0);
  sdrop(4); callsubi();
}

define_instruction(scall42) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(2);
  sref(5) = sref(1); sref(4) = sref(0);
  sdrop(4); callsubi();
}

define_instruction(scall43) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(3);
  sref(6) = sref(2); sref(5) = sref(1); sref(4) = sref(0);
  sdrop(4); callsubi();
}

define_instruction(scall44) {
  ckx(ac); rd = ac; rx = fixnum_obj(0); ac = fixnum_obj(4);
  sref(7) = sref(3); sref(6) = sref(2); sref(5) = sref(1); sref(4) = sref(0);
  sdrop(4); callsubi();
}

define_instruction(brnotlt) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    int dx = get_fixnum(*ip++);
    ac = bool_obj(get_fixnum(x) < get_fixnum(y));
    ip = ac ? ip : ip + dx;
    gonexti(); 
  } else {
    int dx = get_fixnum(*ip++);
    double fx, fy;
    if (likely(is_flonum(x))) fx = get_flonum(x);
    else { cki(x); fx = (double)get_fixnum(x); }
    if (likely(is_flonum(y))) fy = get_flonum(y);
    else { cki(y); fy = (double)get_fixnum(y); }
    ac = bool_obj(fx < fy);
    ip = ac ? ip : ip + dx;
    gonexti(); 
  }
}

define_instruction(pushsub) {
  obj x = ac, y = spop();
  if (likely(are_fixnums(x, y))) {
    long lx = get_fixnum(x), ly = get_fixnum(y);   
    long long llz = (long long)lx - (long long)ly;
    if (likely(llz >= FIXNUM_MIN && llz <= FIXNUM_MAX)) ac = fixnum_obj((long)llz);
    else ac = flonum_obj((double)lx - (double)ly);
  } else {
    double dx, dy;
    if (likely(is_flonum(x))) dx = get_flonum(x);
    else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
    else failtype(x, "number");
    if (likely(is_flonum(y))) dy = get_flonum(y);
    else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
    else failtype(y, "number");
    ac = flonum_obj(dx - dy);
  }
  spush(ac);
  gonexti(); 
}

define_instruction(fexis) {
  FILE *f; cks(ac);
  f = fopen(stringchars(ac), "r"); /* todo: pile #ifdefs here */
  if (f != NULL) fclose(f);
  ac = bool_obj(f != NULL);
  gonexti(); 
}

define_instruction(frem) {
  int res; cks(ac);
  res = remove(stringchars(ac));
  ac = bool_obj(res == 0);
  gonexti(); 
}

define_instruction(fren) {
  int res; cks(ac); cks(sref(0));
  res = rename(stringchars(ac), stringchars(sref(0)));
  spop();
  ac = bool_obj(res == 0);
  gonexti(); 
}

define_instruction(argvref) {
  int i; char *s; ckk(ac);
  i = get_fixnum(ac); /* todo: range-check */
  s = cxg_argv[i];
  if (s) ac = string_obj(newstring(s));
  else ac = bool_obj(0); 
  gonexti(); 
}

define_instruction(getenv) {
  char *v; cks(ac);
  v = getenv(stringchars(ac));
  if (v) ac = string_obj(newstring(v));
  else ac = bool_obj(0);
  gonexti(); 
}

define_instruction(clock) {
  double d = (double)clock();
  ac = flonum_obj(d);
  gonexti(); 
}

define_instruction(clops) {
  double d = (double)CLOCKS_PER_SEC;
  ac = flonum_obj(d);
  gonexti(); 
}

define_instruction(cursec) {
  double d = difftime(time(NULL), 0) + 37.0;
  ac = flonum_obj(d);
  gonexti(); 
}


#define VM_GEN_DEFGLOBAL
#include "i.h"
#undef  VM_GEN_DEFGLOBAL

/* integrables table */
struct intgtab_entry { int sym; char *igname; int igtype; char *enc; char *lcode; };
#define declare_intgtable_entry(enc, igname, igtype, lcode) \
   { 0, igname, igtype, enc, lcode },

static struct intgtab_entry intgtab[] = {
#define VM_GEN_INTGTABLE
#include "i.h"
#undef  VM_GEN_INTGTABLE
};

static int intgtab_sorted = 0;
static int intgtab_cmp(const void *p1, const void *p2)
{
  int igtype1, igtype2;
  struct intgtab_entry *pe1 = (struct intgtab_entry *)p1;
  struct intgtab_entry *pe2 = (struct intgtab_entry *)p2;
  if (pe1->sym < pe2->sym) return -1;
  if (pe1->sym > pe2->sym) return 1;
  igtype1 = pe1->igtype; if (igtype1 >= ' ') igtype1 = ' ';
  igtype2 = pe2->igtype; if (igtype2 >= ' ') igtype2 = ' ';
  if (igtype1 < igtype2) return -1;
  if (igtype1 > igtype2) return 1;
  return 0;
}

static void sort_intgtab(int n)
{
  if (!intgtab_sorted) {
    int i;
    for (i = 0; i < n; ++i) {
      struct intgtab_entry *pe = &intgtab[i];
      pe->sym = pe->igname ? internsym(pe->igname) : 0;
    }
    qsort(&intgtab[0], n, sizeof(intgtab[0]), intgtab_cmp); 
    intgtab_sorted = 1;
  }
} 

static int isintegrable(obj o)
{
  int n = sizeof(intgtab)/sizeof(intgtab[0]);
  if (is_fixnum_obj(o)) {
    int i = fixnum_from_obj(o);
    if (i >= 0 && i < n) {  
      struct intgtab_entry *pe = &intgtab[i];
      return (pe && pe->igtype >= ' ' && pe->igname && pe->enc);
    }
  }
  return 0;
}

static struct intgtab_entry *integrabledata(obj o)
{
  int n = sizeof(intgtab)/sizeof(intgtab[0]);
  int i = fixnum_from_obj(o);
  struct intgtab_entry *pe = &intgtab[i];
  assert(i >= 0 && i < n);
  return pe;
}

static obj mkintegrable(struct intgtab_entry *pe)
{
  int n = sizeof(intgtab)/sizeof(intgtab[0]);
  assert(pe >= &intgtab[0] && pe < &intgtab[n]); 
  return obj_from_fixnum(pe-intgtab);
}

static struct intgtab_entry *lookup_integrable(int sym)
{
  struct intgtab_entry e, *pe;
  int n = sizeof(intgtab)/sizeof(intgtab[0]);
  if (!intgtab_sorted) sort_intgtab(n);
  e.sym = sym; e.igtype = ' ';
  pe = bsearch(&e, &intgtab[0], n, sizeof(intgtab[0]), intgtab_cmp);
  return (pe && pe->igtype >= ' ' && pe->igname && pe->enc) ? pe : NULL;
}

static int integrable_type(struct intgtab_entry *pi)
{
  int it = pi->igtype;
  return (it >= ' ') ? it : 0;
}

static const char *integrable_global(struct intgtab_entry *pi)
{
  return (pi->igtype >= ' ') ? pi->igname : NULL;
}

static const char *integrable_code(struct intgtab_entry *pi, int n)
{
  char *ps, *code = NULL; int it = pi->igtype;
  if (it >= ' ') {
    ps = pi->enc; assert(ps);
    while (ps && n-- > 0) {
      ps += strlen(ps) + 1; /* \0 terminates each field */
      assert(*ps);
    }
    code = ps;
  }
  return code;
}

/* deserialization machinery */

static int rds_char(obj port)
{
  int c = iportgetc(port);
  if (c == '%') {
    char buf[3];
    buf[0] = iportgetc(port); buf[1] = iportgetc(port); buf[2] = 0;
    c = (int)strtol(buf, NULL, 16);
  }
  return c;
}

static int rds_byte(obj port)
{
  char buf[3]; int b;
  buf[0] = iportgetc(port); buf[1] = iportgetc(port); buf[2] = 0;
  b = (int)strtoul(buf, NULL, 16);
  return b;
}

static int rds_int(obj port)
{
  char buf[60], *p = buf, *e = p+59;
  while (p < e) {
    int c = iportpeekc(port);
    if (c == '-' || c == '+' || (c >= '0' && c <= '9')) {
      iportgetc(port);
      *p++ = c;
    } else break;
  } 
  *p = 0;
  return (int)strtol(buf, NULL, 10);
}

static double rds_real(obj port)
{
  char buf[60], *p = buf, *e = p+59, *s; double d;
  while (p < e) {
    int c = iportpeekc(port);
    if (c == '-' || c == '+' || c == '.' || isalnum(c)) {
      iportgetc(port);
      *p++ = c;
    } else break;
  } 
  *p = 0;
  errno = 0; s = buf; e = "";
  if (*s != '+' && *s != '-') d = strtod(s, &e);
  else if (strcmp_ci(s+1, "inf.0") == 0) d = (*s == '-' ? -HUGE_VAL : HUGE_VAL); 
  else if (strcmp_ci(s+1, "nan.0") == 0) d = HUGE_VAL - HUGE_VAL; 
  else d = strtod(s, &e);
  if (errno || e == s || *e) assert(0);
  return d;
}

static size_t rds_size(obj port)
{
  int n = rds_int(port);
  if ((n < 0) || iportgetc(port) != ':') return 0; /* postpone failure */
  return (size_t)n;
}

/* see below */
static obj *rds_sexp(obj *r, obj *sp, obj *hp);

/* protects registers from r to sp, in: ra=port, out: ra=sexp/eof */
static obj *rds_elt(obj *r, obj *sp, obj *hp)
{
  obj port = ra;
  spush(port);
  hp = rds_sexp(r, sp, hp);
  port = spop();
  if (!iseof(ra) && iportgetc(port) != ';') ra = mkeof();
  return hp;
}

/* protects registers from r to sp, in: ra=port, out: ra=sexp/eof */
static obj *rds_sexp(obj *r, obj *sp, obj *hp)
{
  obj port = ra;
  int c = iportgetc(port);
  switch (c) {
    default:  ra = mkeof(); break;
    case 'f': ra = obj_from_bool(0); break;
    case 't': ra = obj_from_bool(1); break;
    case 'n': ra = mknull(); break;
    case 'c': ra = obj_from_char(rds_char(port)); break;
    case 'i': ra = obj_from_fixnum(rds_int(port)); break; 
    case 'j': ra = obj_from_flonum(sp-r, rds_real(port)); break;
    case 'p': {
      spush(port);
      ra = sref(0); hp = rds_elt(r, sp, hp); 
      if (iseof(ra)) { sdrop(1); return hp; } else spush(ra);
      ra = sref(1); hp = rds_elt(r, sp, hp); 
      if (iseof(ra)) { sdrop(2); return hp; } else spush(ra);
      hreserve(pairbsz(), sp-r);
      *--hp = sref(0);  
      *--hp = sref(1);  
      ra = hend_pair();
      sdrop(3);      
    } break; 
    case 'l': {
      size_t n = rds_size(port), i;
      spush(port); /* sref(0)=port */
      for (i = 0; i < n; ++i) {
        ra = sref((int)i); hp = rds_elt(r, sp, hp); 
        if (iseof(ra)) { sdrop(i+1); return hp; } else spush(ra);
      }
      hreserve(pairbsz()*n, sp-r);
      ra = mknull();
      for (i = 0; i < n; ++i) {
        *--hp = ra;  
        *--hp = sref((int)i);  
        ra = hend_pair();
      }      
      sdrop(n+1);
    } break; 
    case 'v': {
      size_t n = rds_size(port), i;
      spush(port);
      for (i = 0; i < n; ++i) {
        ra = sref((int)i); hp = rds_elt(r, sp, hp); 
        if (iseof(ra)) { sdrop(i+1); return hp; } else spush(ra);
      }
      hreserve(vecbsz(n), sp-r);
      hp -= n; memcpy(hp, sp-n, n*sizeof(obj));      
      ra = hend_vec(n);
      sdrop(n+1);
    } break;
    case 's': case 'y': {
      cbuf_t *pcb = newcb();
      size_t n = rds_size(port), i;
      for (i = 0; i < n; ++i) {
        int x = rds_char(port);
        cbputc(x, pcb);
      }
      if (c == 's') ra = hpushstr(sp-r, newstring(cbdata(pcb)));
      else ra = mksymbol(internsym(cbdata(pcb)));
      freecb(pcb);
    } break;
    case 'b': {
      cbuf_t *pcb = newcb();
      size_t n = rds_size(port), i;
      for (i = 0; i < n; ++i) {
        int x = rds_byte(port);
        cbputc(x, pcb);
      }
      ra = hpushu8v(sp-r, newbytevector((unsigned char *)cbdata(pcb), (int)cblen(pcb)));
      freecb(pcb);
    }
  }  
  return hp;
}

/* protects registers from r to sp, in: ra=str, out: ra=sexp/eof */
static obj *rds_stox(obj *r, obj *sp, obj *hp)
{
  int *d = dupstring(stringdata(ra));
  ra = mkiport_string(sp-r, sialloc(sdatachars(d), d));
  hp = rds_sexp(r, sp, hp);  /* ra=port => ra=sexp/eof */
  return hp;
}

static struct { obj *pg; const char *enc; int etyp; } enctab[] = {
#define VM_GEN_ENCTABLE
#define declare_enctable_entry(name, enc, etyp) \
 { &glue(cx_ins_2D, name), enc, etyp },
#include "i.h"
#undef declare_enctable_entry
#undef VM_GEN_ENCTABLE
 { NULL, NULL, 0 }
};

struct emtrans { int c; struct embranch *pbr; struct emtrans *ptr; };
struct embranch { obj g; int etyp; struct emtrans *ptr; };
static struct embranch encmap = { 0, 0, NULL };

static void encmap_add(const char *enc, obj g, int etyp)
{
  const char *pc = enc; struct embranch *pbr = &encmap;
  down: while (*pc) {
    int c = *pc++; struct emtrans *ptr = pbr->ptr;
    while (ptr != NULL) {
      if (ptr->c != c) {
        if (ptr->ptr == NULL) break;
        ptr = ptr->ptr; continue;
      }
      pbr = ptr->pbr; goto down; 
    }
    if (!(ptr = calloc(1, sizeof(struct emtrans)))) 
      { perror("encmap[memt]"); exit(2); }
    ptr->c = c; ptr->ptr = pbr->ptr; pbr->ptr = ptr;
    if (!(ptr->pbr = calloc(1, sizeof(struct embranch)))) 
      { perror("encmap[memb]"); exit(2); }
    pbr = ptr->pbr;
  }
  if (pbr->g != 0) { 
    perror("encmap[dup]"); exit(2); 
  }
  pbr->g = g; pbr->etyp = etyp;
}

static struct embranch *get_encmap(void)
{
  if (encmap.ptr == NULL) {
    size_t i;
    for (i = 0; enctab[i].pg != NULL; ++i) {
      if (enctab[i].enc != NULL) {
        encmap_add(enctab[i].enc, *(enctab[i].pg), enctab[i].etyp);
      }
    }
    assert(encmap.g == 0);
    assert(encmap.ptr != NULL);
  }
  return &encmap;
} 

static struct embranch *rds_prefix(obj port)
{
  struct embranch *pbr = get_encmap(); int c;
  down: while ((c = iportpeekc(port)) != EOF) {
    struct emtrans *ptr = pbr->ptr;
    while (ptr != NULL) {
      if (ptr->c != c) {
        if (ptr->ptr == NULL) break;
        ptr = ptr->ptr; continue;
      }
      pbr = ptr->pbr; iportgetc(port); 
      goto down; 
    }
    break;
  }
  return pbr;
}

static obj lastpair(obj l)
{
  obj p = bool_obj(0);
  while (ispair(l)) { p = l; l = cdr(l); }
  return p;
}

static fixnum_t length(obj l)
{
  fixnum_t n = 0;
  while (ispair(l)) { ++n; l = cdr(l); }
  return n;
}

/* protects registers from r to sp, in: ra=list, out: ra=vec */
obj *revlist2vec(obj *r, obj *sp, obj *hp)
{
  obj l; fixnum_t n = length(ra), i;
  hreserve(vecbsz(n), sp-r);
  for (l = ra, i = 0; i < n; ++i, l = cdr(l)) *--hp = pair_car(l);
  ra = hend_vec(n);
  return hp;
}

/* protects registers from r to sp, in: ra=code, out: ra=closure */
obj *close0(obj *r, obj *sp, obj *hp)
{
  hreserve(vmclobsz(1), sp-r);
  *--hp = ra;
  ra = hend_vmclo(1);
  return hp;
}

/* protects registers from r to sp, in: ra=port, out: ra=sexp/eof */
static obj *rds_arg(obj *r, obj *sp, obj *hp)
{
  obj port = ra; int c = iportgetc(port);
  if ('0' <= c && c <= '9') {
    ra = obj_from_fixnum(c-'0');
  } else {
    if (c != '(') ra = mkeof(); else {
      spush(port);
      ra = sref(0); hp = rds_sexp(r, sp, hp); 
      port = sref(0);
      if (!iseof(ra) && iportgetc(port) != ')') ra = mkeof();
      sdrop(1); 
    }
  }
  return hp;
}

/* protects registers from r to sp, in: ra=sym, out: ra=loc/eof */
static obj *rds_global_loc(obj *r, obj *sp, obj *hp)
{
  if (issymbol(ra)) {
    obj p = isassv(ra, cx__2Aglobals_2A);
    if (ispair(p)) ra = cdr(p);
    else { /* prepend (sym . #&sym) to *globals* */
      obj box;
      hreserve(boxbsz()*1+pairbsz()*2, sp-r);
      *--hp = ra;
      box = hend_box();
      *--hp = box; *--hp = ra;
      ra = hend_pair();
      *--hp = cx__2Aglobals_2A; *--hp = ra;
      cx__2Aglobals_2A = hend_pair();
      ra = box;
    }
  } else {
    ra = mkeof();
  }
  return hp;
}


/* see below */
static obj *rds_seq(obj *r, obj *sp, obj *hp);

/* protects registers from r to sp, in: ra=port, out: ra=sexp/eof */
static obj *rds_block(obj *r, obj *sp, obj *hp)
{
  obj port = ra; int c = iportgetc(port);
  if (c != '{') ra = mkeof(); else {
    spush(port);
    ra = sref(0); hp = rds_seq(r, sp, hp); 
    port = sref(0);
    if (!iseof(ra) && iportgetc(port) != '}') ra = mkeof();
    sdrop(1); 
  }
  return hp; 
}

/* protects registers from r to sp, in: ra=port, out: ra=sexp/eof */
static obj *rds_seq(obj *r, obj *sp, obj *hp)
{
  obj port = ra; int c;
  spush(port);      /* sref[1] = port */
  spush(mknull());  /* sref[0] = l */
more:  
  c = iportpeekc(sref(1));
  if (c == EOF) {
    hreserve(pairbsz(), sp-r);
    *--hp = sref(0); *--hp = glue(cx_ins_2D, halt);  
    ra = hend_pair();
  } else if (c == '}') { 
    ra = sref(0);
  } else {
    struct embranch *pbr = rds_prefix(sref(1));
    if (pbr->g == 0) {
      /* fprintf(stderr, "### rds_seq's remaining chars:\n");
      while (iportpeekc(sref(1)) != EOF) fputc(iportgetc(sref(1)), stderr);
      fputc('\n', stderr); */
      ra = mkeof();
    } else switch (pbr->etyp) {
      case 0: {
        hreserve(pairbsz(), sp-r);
        *--hp = sref(0); *--hp = pbr->g;  
        sref(0) = hend_pair();
        goto more;
      } break;
      case 1: {
        ra = sref(1); hp = rds_arg(r, sp, hp);
        if (iseof(ra)) goto out;
        hreserve(pairbsz()*2, sp-r);
        *--hp = sref(0); *--hp = pbr->g;  
        sref(0) = hend_pair();
        *--hp = sref(0); *--hp = ra;  
        sref(0) = hend_pair();
        goto more;
      } break;
      case 2: {
        ra = sref(1); hp = rds_arg(r, sp, hp);
        if (iseof(ra)) goto out;
        hreserve(pairbsz()*2, sp-r);
        *--hp = sref(0); *--hp = pbr->g;  
        sref(0) = hend_pair();
        *--hp = sref(0); *--hp = ra;  
        sref(0) = hend_pair();
        ra = sref(1); hp = rds_arg(r, sp, hp);
        if (iseof(ra)) goto out;
        hreserve(pairbsz(), sp-r);
        *--hp = sref(0); *--hp = ra;  
        sref(0) = hend_pair();
        goto more;
      } break;
      case 'f': case 't': case 'n': {
        hreserve(pairbsz()*2, sp-r);
        *--hp = sref(0); *--hp = pbr->g;  
        sref(0) = hend_pair();
        *--hp = sref(0); *--hp = (pbr->etyp == 'n' ? mknull() : obj_from_bool(pbr->etyp == 't'));
        sref(0) = hend_pair();
        goto more;
      } break;
      case 'g': { /* gref/gset */
        ra = sref(1); hp = rds_arg(r, sp, hp);
        if (iseof(ra)) goto out;
        hp = rds_global_loc(r, sp, hp); /* ra => ra */
        if (iseof(ra)) goto out;
        hreserve(pairbsz()*2, sp-r); 
        *--hp = sref(0); *--hp = pbr->g;  
        sref(0) = hend_pair();
        *--hp = sref(0); *--hp = ra;
        sref(0) = hend_pair();
        goto more;
      } break;
      case 'a': { /* andbo */
        hreserve(pairbsz(), sp-r);
        *--hp = sref(0); *--hp = pbr->g;  
        sref(0) = hend_pair();
        c = iportpeekc(sref(1));
        if (c == EOF || c == '}') { ra = mkeof(); goto out; }
        pbr = rds_prefix(sref(1));
        if (pbr->g == 0 || pbr->etyp != 0) { ra = mkeof(); goto out; }
        hreserve(pairbsz(), sp-r);
        *--hp = sref(0); *--hp = pbr->g;  
        sref(0) = hend_pair();
        goto more;
      } break;
      case 's': { /* save */
        fixnum_t n;
        ra = sref(1); hp = rds_block(r, sp, hp);
        if (iseof(ra)) goto out;
        n = length(ra);
        hreserve(pairbsz()*2, sp-r); 
        *--hp = sref(0); *--hp = pbr->g;  
        sref(0) = hend_pair();
        *--hp = sref(0); *--hp = obj_from_fixnum(n);
        sref(0) = hend_pair();
        if (n > 0) {
          obj lp = lastpair(ra); assert(ispair(lp));
          cdr(lp) = sref(0); sref(0) = ra;
        }
        goto more;
      } break;
      case 'd': { /* dclose */
        fixnum_t n;
        ra = sref(1); hp = rds_arg(r, sp, hp);
        if (!is_fixnum_obj(ra)) { ra = mkeof(); goto out; }
        n = get_fixnum(ra);
        ra = sref(1); hp = rds_block(r, sp, hp);
        if (iseof(ra)) goto out;
        hp = revlist2vec(r, sp, hp); /* ra => ra */
        if (iseof(ra)) goto out;
        hreserve(pairbsz()*3, sp-r); 
        *--hp = sref(0); *--hp = pbr->g;  
        sref(0) = hend_pair();
        *--hp = sref(0); *--hp = obj_from_fixnum(n);
        sref(0) = hend_pair();
        *--hp = sref(0); *--hp = ra;  
        sref(0) = hend_pair();
        goto more;
      } break;
      case 'b': { /* branches */
        fixnum_t n; int c;
        ra = sref(1); hp = rds_block(r, sp, hp);
        if (iseof(ra)) goto out;
        c = iportpeekc(sref(1));
        if (c == '{') { /* 2-arm branch combo */
          obj bseq1 = ra, bseq2;
          spush(bseq1); /* ... port, l, bseq1 <= sp */
          ra = sref(2); hp = rds_block(r, sp, hp);
          if (iseof(ra)) { sdrop(1); goto out; }
          hreserve(pairbsz()*4, sp-r); 
          bseq1 = spop(); bseq2 = ra;
          n = length(bseq1);
          *--hp = sref(0); *--hp = pbr->g;  
          sref(0) = hend_pair();
          *--hp = sref(0); *--hp = obj_from_fixnum(n+2);
          sref(0) = hend_pair();
          if (n > 0) {
            obj lp = lastpair(bseq1); assert(ispair(lp));
            cdr(lp) = sref(0); sref(0) = bseq1;
          }
          *--hp = sref(0); *--hp = glue(cx_ins_2D, br);
          sref(0) = hend_pair();
          n = length(bseq2);
          *--hp = sref(0); *--hp = obj_from_fixnum(n);
          sref(0) = hend_pair();
          if (n > 0) {
            obj lp = lastpair(bseq2); assert(ispair(lp));
            cdr(lp) = sref(0); sref(0) = bseq2;
          }
        } else { /* regular 1-arm branch */
          n = length(ra);
          hreserve(pairbsz()*2, sp-r); 
          *--hp = sref(0); *--hp = pbr->g;  
          sref(0) = hend_pair();
          *--hp = sref(0); *--hp = obj_from_fixnum(n);
          sref(0) = hend_pair();
          if (n > 0) {
            obj lp = lastpair(ra); assert(ispair(lp));
            cdr(lp) = sref(0); sref(0) = ra;
          }
        }
        goto more;
      } break;
      default: assert(0);
    } 
  }
out:
  sdrop(2);
  return hp;
}

/* protects registers from r to sp, in: ra=str, out: ra=codevec/eof */
static obj *rds_stoc(obj *r, obj *sp, obj *hp)
{
  int *d = dupstring(stringdata(ra));
  /* fprintf(stderr, "** rds_stoc(%s)\n", sdatachars(d)); */
  ra = mkiport_string(sp-r, sialloc(sdatachars(d), d));
  hp = rds_seq(r, sp, hp);  /* ra=port => ra=revcodelist/eof */
  if (!iseof(ra)) hp = revlist2vec(r, sp, hp); /* ra => ra */
  return hp;
}


/* protects registers from r to sp */
static obj *rds_intgtab(obj *r, obj *sp, obj *hp)
{
  int i, n = sizeof(intgtab)/sizeof(intgtab[0]);
  char lbuf[200], *lcode, *pe0, *pe1;
  if (!intgtab_sorted) sort_intgtab(n);
  for (i = 0; i < n; ++i) {
    struct intgtab_entry *pe = &intgtab[i];
    if (!pe->igname) continue; 
    lcode = pe->lcode;
    if (!lcode) switch (pe->igtype) {
      case '0': {
        lcode = lbuf; assert(pe->enc);
        sprintf(lbuf, "%%0%s]0", pe->enc); 
      } break; 
      case '1': {
        lcode = lbuf; assert(pe->enc);
        sprintf(lbuf, "%%1_!%s]0", pe->enc);
      } break;
      case '2': {
        lcode = lbuf; assert(pe->enc);
        sprintf(lbuf, "%%2_!%s]0", pe->enc);
      } break;
      case '3': {
        lcode = lbuf; assert(pe->enc); 
        sprintf(lbuf, "%%3_!%s]0", pe->enc);
      } break;
      case 'p': {
        lcode = lbuf; assert(pe->enc); 
        pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
        sprintf(lbuf, "%%!0.0u?{%s]1}.0d,.1a,,#0.0,&1{%%2.1u?{.0]2}.1d,.2a,.2%s,:0^[22}.!0.0^_1[12", pe1, pe0);
      } break;
      case 'm': {
        lcode = lbuf; assert(pe->enc); 
        pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
        sprintf(lbuf, "%%!1.0u?{.1%s]2}.0,.2,,#0.0,&1{%%2.1u?{.0]2}.1d,.2a,.2%s,:0^[22}.!0.0^_1[22", pe1, pe0);
      } break;
      case 'c': {
        lcode = lbuf; assert(pe->enc);
        sprintf(lbuf, "%%!0.0u,.0?{.0]2}.1d,.2a,,#0.0,&1{%%2.1u,.0?{.0]3}.2a,.0,.3%s?{.3d,.1,:0^[42}f]4}.!0.0^_1[22", pe->enc);
      } break;
      case 'x': {
        lcode = lbuf; assert(pe->enc);
        sprintf(lbuf, "%%!1.0,.2,,#0.0,&1{%%2.1u?{.0]2}.1d,.2a,.2%s,:0^[22}.!0.0^_1[22}", pe->enc);
      } break;
      case 'u': {
        lcode = lbuf; assert(pe->enc); 
        pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
        sprintf(lbuf, "%%!0.0u?{%s%s]1}.0du?{.0a%s]1}%%%%", pe1, pe0, pe0);
      } break;
      case 'b': {
        lcode = lbuf; assert(pe->enc); 
        pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
        sprintf(lbuf, "%%!1.0u?{%s,.2%s]2}.0du?{.0a,.2%s]2}%%%%", pe1, pe0, pe0);
      } break;
      case 't': {
        lcode = lbuf; assert(pe->enc); 
        pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
        sprintf(lbuf, "%%!2.0u?{%s,.3,.3%s]3}.0du?{.0a,.3,.3%s]3}%%%%", pe1, pe0, pe0);
      } break;
      case '#': /* must have explicit lcode */
        assert(0); 
      case '@': /* must have explicit lcode */
        assert(0); 
      default:
        assert(0); 
    }
    if (!lcode || *lcode == 0) continue;
    ra = mksymbol(internsym(pe->igname));
    hp = rds_global_loc(r, sp, hp); /* ra->ra */
    spush(ra); assert(isbox(ra));
    ra = mkiport_string(sp-r, sialloc(lcode, NULL));
    hp = rds_seq(r, sp, hp);  /* ra=port => ra=revcodelist/eof */
    if (!iseof(ra)) hp = revlist2vec(r, sp, hp); /* ra => ra */
    if (!iseof(ra)) hp = close0(r, sp, hp); /* ra => ra */
    if (!iseof(ra)) boxref(spop()) = ra;
  }
  return hp;
}

/* protects registers from r to sp=r+2; returns new hp */
static obj *init_module(obj *r, obj *sp, obj *hp, const char **mod)
{
  const char **ent;
  /* make sure we are called in a clean vm state */
  assert(r == cxg_regs); assert(sp-r == VM_REGC); /* k, ra (for temp use) */
  /* go over module entries and install/execute */
  for (ent = mod; ent[0] != NULL || ent[1] != NULL; ent += 2) {
    const char *name = ent[0], *data = ent[1];
    /* fprintf(stderr, "## initializing: %s\n%s\n", name?name:"NULL", data); */
    if (name != 0 && name[0] == 'S' && name[1] == 0) {
      /* 'syntax' entry: skip prefix */
      ent += 1; name = ent[0], data = ent[1];
      assert(name != 0); assert(data != 0);
    } else if (name != 0 && name[0] == 'C' && name[1] == 0) {
      /* 'command' entry: skip prefix */
      ent += 1; name = ent[0], data = ent[1];
      assert(name == 0); assert(data != 0);
    } else if (name != 0 && name[0] == 'P' && name[1] == 0) {
      /* 'procedure' entry: make closure and install */
      ent += 1; name = ent[0], data = ent[1];
      assert(name != 0); assert(data != 0);
      /* install code */
      ra = mksymbol(internsym((char*)name));
      hp = rds_global_loc(r, sp, hp); /* ra->ra */
      spush(ra); assert(isbox(ra));
      ra = mkiport_string(sp-r, sialloc((char*)data, NULL));
      hp = rds_seq(r, sp, hp);  /* ra=port => ra=revcodelist/eof */
      if (!iseof(ra)) hp = revlist2vec(r, sp, hp); /* ra => ra */
      if (!iseof(ra)) hp = close0(r, sp, hp); /* ra => ra */
      if (!iseof(ra)) boxref(spop()) = ra;
      continue;
    } else if (name != 0 && name[0] == 'A' && name[1] == 0) {
      /* 'alias' entry: copy transformer */
      obj oldsym, sym, oldbnd, oldden, bnd, al;
      struct intgtab_entry *pe;
      ent += 1; name = ent[0], data = ent[1];
      assert(name != 0); assert(data != 0);
      /* look for dst binding (we allow redefinition) */
      oldsym = mksymbol(internsym((char*)data));
      sym = mksymbol(internsym((char*)name));
      for (oldbnd = 0, al = cx__2Atransformers_2A; al != mknull(); al = cdr(al)) {
        obj ael = car(al);
        if (car(ael) != oldsym) continue;
        oldbnd = ael; break;
      }
      oldden = oldbnd ? cdr(oldbnd) : 0;
      /* missing binding could be an auto-installed integrable */
      if (!oldden && (pe = lookup_integrable(getsymbol(oldsym)))) {
        oldden = mkintegrable(pe);
      }
      /* we should have it now */
      assert(oldden); if (!oldden) continue;
      /* look for existing binding (we allow redefinition) */
      for (bnd = 0, al = cx__2Atransformers_2A; al != mknull(); al = cdr(al)) {
        obj ael = car(al);
        if (car(ael) != sym) continue; 
        bnd = ael; break;
      }
      /* or add new binding */
      spush(oldden); /* protect from gc */
      if (!bnd) { /* acons (sym . #f) */
        hreserve(pairbsz()*2, sp-r);
        *--hp = obj_from_bool(0); *--hp = sym;
        bnd = hend_pair();
        *--hp = cx__2Atransformers_2A; *--hp = bnd;
        cx__2Atransformers_2A = hend_pair();
      }
      cdr(bnd) = spop(); /* oldden */
      continue;    
    } else if (name != 0 && name[0] == 'K' && name[1] == 0) {
      /* special entry for cx_continuation_2Dadapter_2Dcode */
      ent += 1; name = ent[0], data = ent[1];
      assert(name == 0); assert(data != 0);
      ra = mkiport_string(sp-r, sialloc((char*)data, NULL));
      hp = rds_seq(r, sp, hp);  /* ra=port => ra=revcodelist/eof */
      if (!iseof(ra)) hp = revlist2vec(r, sp, hp); /* ra => ra */
      assert(!iseof(ra));
      cx_continuation_2Dadapter_2Dcode = ra;
      continue;
    }
    /* skipped prefix or no prefix */
    if (name != NULL) {
      /* install sexp-encoded syntax-rules as a transformer */
      obj sym = mksymbol(internsym((char*)name));
      obj al = cx__2Atransformers_2A, bnd = mknull();
      assert(ispair(al)); /* basic transformers already installed */
      /* look for existing binding (we allow redefinition) */
      while (al != mknull()) {
        obj ael = car(al);
        if (car(ael) != sym) { al = cdr(al); continue; }
        bnd = ael; break;
      }
      /* or add new binding */
      if (bnd == mknull()) { /* acons (sym . #f) */
        hreserve(pairbsz()*2, sp-r);
        *--hp = obj_from_bool(0); *--hp = sym;
        bnd = hend_pair();
        *--hp = cx__2Atransformers_2A; *--hp = bnd;
        cx__2Atransformers_2A = hend_pair();
      }
      /* sexp-decode data into the cdr of the binding */
      spush(bnd); /* protect from gc */
      ra = mkiport_string(sp-r, sialloc((char*)data, NULL));
      hp = rds_sexp(r, sp, hp);  /* ra=port => ra=sexp/eof */      
      bnd = spop();
      assert(ispair(bnd) && (ispair(ra) || issymbol(ra)));
      cdr(bnd) = ra;
    } else {
      /* execute code-encoded thunk */
      obj *ip;
#ifdef VM_AC_IN_REG
      obj ac;
#endif      
      ra = mkiport_string(sp-r, sialloc((char*)data, NULL));
      hp = rds_seq(r, sp, hp);  /* ra=port => ra=revcodelist/eof */
      if (!iseof(ra)) hp = revlist2vec(r, sp, hp); /* ra => ra */
      if (!iseof(ra)) hp = close0(r, sp, hp); /* ra => ra */
      assert(!iseof(ra));
      /* ra is a thunk closure to execute */
      rd = ra;
      ra = obj_from_fixnum(0); /* argc, shadow ac */
      rx = obj_from_fixnum(0); /* shadow ip */ 
      rs = obj_from_fixnum(VM_REGC); /* sp */
      rz = (obj)(r + VM_STACK_GSZ); /* sp red zone */
      do { /* unwindi trampoline */
        reload_ac(); /* ra => ac */
        reload_ip(); /* rd/rx => ip */
        reload_sp(); /* rs => sp */
        hp = (ins_from_obj(*ip))(IARGS1);
      } while (trampcnd());
      /* r[0] = k, r[1] = random result */
      assert(r == cxg_regs);
      sp = r + VM_REGC;
    }
  }
  return hp;
}

/* partially hand-coded module (prototyped in i.scm) */
char *i_code[] = {

  /* initialize current port variables */
  "C", 0,
  "P10Psi" "P11Pso" "P12Pse",

  /* internal continuation switch code */
  "P", "%dynamic-state-reroot!",
  "%1.0,,#0.0,&1{%1.0,yq~?{${.2d,:0^[01}.0ad,.1aa,y,.1,.3c,.1sa.3,.1sdf,."
  "4san,.4sd.3sy_1.0[30}]1}.!0.0^_1[11",

  /* code for dynamic-wind's internal lambda is modified as follows:
   * ,    save argc by pushing it on top of args in stack
   * ${   push new frame for return from %dynamic-state-reroot!
   * :0   get 'here' dynamic state from internal lambda's display
   * ,    put it on the stack for dynamic-state-reroot!
   * @(y22:%25dynamic-state-reroot!) get the d-s-r! procedure
   * [01  call it with 1 argument ('here' dynamic state)
   * }    we will return here when d-s-r! is finished 
   * _!   pop saved argc from stack into ac register
   * K6   use sdmv opcode to return args from the lambda
   * also, %x procedure checks inserted for early error detection
  */
  "P", "dynamic-wind",
  "%3y,${.2,.6%x,.5%xcc,@(y22:%25dynamic-state-reroot!)[01}.0,&1{,${:0,@("
  "y22:%25dynamic-state-reroot!)[01}_!K6},.3,@(y16:call-with-values)[42",

  /* code for the continuation adapter:
   * k!   first attempt; does not return if nothing to un/re-wind
   * ,    save argc by pushing it on top of args in stack
   * ${   push new frame for return from %dynamic-state-reroot!
   * :0   get old dynamic state from continuation's display
   * ,    put it on the stack for dynamic-state-reroot!
   * @(y22:%25dynamic-state-reroot!) get the d-s-r! procedure
   * [01  call it with 1 argument (old dynamic state)
   * }    we will return here when d-s-r! is finished 
   * _!   pop saved argc from stack; we are ready to retry
   * k!   retry; should not return this time
   * %%   signal an (argument?) error if we return ?? */
  "K", 0, 
  "k!,${:0,@(y22:%25dynamic-state-reroot!)[01}_!k!%%",

  0, 0, 0
};

/* protects registers from r to sp=r+2; returns new hp */
static obj *init_modules(obj *r, obj *sp, obj *hp)
{
  extern char* i_code[]; /* i.c */
  extern char* s_code[]; /* s.c */
  extern char* t_code[]; /* t.c */
  hp = init_module(r, sp, hp, (const char **)i_code);
  hp = init_module(r, sp, hp, (const char **)s_code);
  hp = init_module(r, sp, hp, (const char **)t_code);
  return hp;
}