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