static SCM
create_subr (int define, const char *name,
unsigned int nreq, unsigned int nopt, unsigned int rest,
SCM (*fcn) (), SCM *generic_loc)
{
SCM ret, sname;
scm_t_bits flags;
scm_t_bits nfree = generic_loc ? 3 : 2;
sname = scm_from_utf8_symbol (name);
flags = SCM_F_PROGRAM_IS_PRIMITIVE;
flags |= generic_loc ? SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC : 0;
ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
SCM_SET_CELL_WORD_1 (ret, get_subr_stub_code (nreq, nopt, rest));
SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, scm_from_pointer (fcn, NULL));
SCM_PROGRAM_FREE_VARIABLE_SET (ret, 1, sname);
if (generic_loc)
SCM_PROGRAM_FREE_VARIABLE_SET (ret, 2,
scm_from_pointer (generic_loc, NULL));
if (define)
scm_define (sname, ret);
return ret;
}
SCM scm_gunzip_buf(SCM scm_buf, SCM scm_outlen){
//this should typecheck buf for us
size_t buflen = scm_c_bytevector_length(scm_buf);
uint8_t *buf = (uint8_t*)SCM_BYTEVECTOR_CONTENTS(scm_buf);
size_t outlen = scm_to_size_t(scm_outlen);
uint8_t *out = scm_gc_malloc_pointerless(outlen, SCM_GC_BYTEVECTOR);
z_stream stream = {.next_in = buf, .avail_in = buflen,
.next_out = out, .avail_out = outlen,
.zalloc = NULL, .zfree = NULL, .opaque = NULL};
//15 | 16 means use 15 bits for the decompression window, and only accept
//gzip compressed buffers
inflateInit2(&stream, 15 | 16);
int status = inflate(&stream, Z_FINISH);
if(status != Z_STREAM_END){ //the output buffer was too small
//Do something useful here, for now this just makes sure that
//we don't cause any errors
fprintf(stderr, "Return value was %d, expecting %d\n",
status, Z_FINISH);
scm_gc_free(out, outlen, SCM_GC_BYTEVECTOR);
SCM ret = scm_from_utf8_string(stream.msg);
inflateEnd(&stream);
return ret;
}
//I don't know what the tag bits for a bytevector are so I need to
//make an empty one.
SCM bv = scm_c_make_bytevector(0);
SCM_SET_CELL_WORD_1(bv, stream.total_out);
SCM_SET_CELL_WORD_2(bv, out);
inflateEnd(&stream);
return bv;
}
static SCM
make_continuation_trampoline (SCM contregs)
{
SCM ret;
scm_t_bits nfree = 1;
scm_t_bits flags = SCM_F_PROGRAM_IS_CONTINUATION;
ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
SCM_SET_CELL_WORD_1 (ret, continuation_stub_code);
SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, contregs);
return ret;
}
static SCM
make_partial_continuation (SCM vm_cont)
{
scm_t_bits nfree = 1;
scm_t_bits flags = SCM_F_PROGRAM_IS_PARTIAL_CONTINUATION;
SCM ret;
ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
SCM_SET_CELL_WORD_1 (ret, compose_continuation_code);
SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, vm_cont);
return ret;
}
