cell_t *new_string_of_size(secd_t *secd, size_t size) { cell_t *mem; mem = alloc_array(secd, bytes_to_cell(size)); assert_cell(mem, "new_string_of_size: alloc failed"); return new_strref(secd, mem, size); }
static cell_t *read_bytevector(secd_parser_t *p) { secd_t *secd = p->secd; assert(p->token == '(', "read_bytevector: '(' expected"); cell_t *tmplist = SECD_NIL; cell_t *cur; size_t len = 0; while (lexnext(p) == TOK_NUM) { assert((0 <= p->numtok) && (p->numtok < 256), "read_bytevector: out of range"); cell_t *newc = new_cons(secd, new_number(secd, p->numtok), SECD_NIL); if (not_nil(tmplist)) { cur->as.cons.cdr = share_cell(secd, newc); cur = newc; } else { tmplist = cur = newc; } ++len; } cell_t *bvect = new_bytevector_of_size(secd, len); assert_cell(bvect, "read_bytevector: failed to allocate"); unsigned char *mem = (unsigned char *)strmem(bvect); cur = tmplist; size_t i; for (i = 0; i < len; ++i) { mem[i] = (unsigned char)numval(list_head(cur)); cur = list_next(secd, cur); } free_cell(secd, tmplist); return bvect; }
cell_t *new_array(secd_t *secd, size_t size) { /* try to allocate memory */ cell_t *mem = alloc_array(secd, size); assert_cell(mem, "new_array: memory allocation failed"); arr_meta(mem)->as.mcons.cells = true; return new_array_for(secd, mem); }
cell_t *new_fileport(secd_t *secd, void *f, const char *mode) { cell_t *cell = pop_free(secd); assert_cell(cell, "new_fileport: allocation failed"); cell->type = CELL_PORT; cell->as.port.file = true; cell->as.port.as.file = f; return init_port_mode(secd, cell, mode); }
cell_t *setup_frame(secd_t *secd, cell_t *argnames, cell_t *argvals, cell_t *env) { cell_t *args_io = SECD_NIL; /* setup the new frame */ cell_t *frame = new_frame(secd, argnames, argvals); cell_t *ret = walk_through_arguments(secd, frame, &args_io); assert_cell(ret, "setup_frame: argument check failed"); cell_t *new_io = new_frame_io(secd, args_io, env); assert_cell(new_io, "setup_frame: failed to set new frame I/O\n"); frame->as.frame.io = share_cell(secd, new_io); secd->input_port = get_car(new_io); secd->output_port = get_cdr(new_io); return frame; }
cell_t * run_secd(secd_t *secd, cell_t *ctrl) { cell_t *op, *ret; TIMING_DECLARATIONS(ts_then, ts_now); share_cell(secd, ctrl); set_control(secd, &ctrl); while (true) { TIMING_START_OPERATION(ts_then); op = pop_control(secd); assert_cell(op, "run: no command"); if (cell_type(op) != CELL_OP) { errorf("run: not an opcode at [%ld]\n", cell_index(secd, op)); dbg_printc(secd, op); continue; } int opind = op->as.op; if (about_to_halt(secd, opind, &ret)) return ret; secd_opfunc_t callee = (secd_opfunc_t) opcode_table[ opind ].fun; ret = callee(secd); if (is_error(ret)) if (!handle_exception(secd, ret)) return fatal_exception(secd, ret, opind); drop_cell(secd, op); TIMING_END_OPERATION(ts_then, ts_now) run_postop(secd); ++secd->tick; } }
static cell_t *read_token(secd_t *secd, secd_parser_t *p) { int tok; cell_t *inp = NULL; switch (tok = p->token) { case '(': ++p->nested; inp = read_list(secd, p); if (p->token != ')') goto error_exit; return inp; case TOK_NUM: return new_number(secd, p->numtok); case TOK_CHAR: return new_char(secd, p->numtok); case TOK_SYM: return new_symbol(secd, p->symtok); case TOK_STR: inp = new_string(secd, strmem(p->strtok)); drop_cell(secd, p->strtok); return inp; case TOK_EOF: return new_symbol(secd, EOF_OBJ); case TOK_QUOTE: case TOK_QQ: case TOK_UQ: case TOK_UQSPL: { const char *formname = special_form_for(tok); assert(formname, "No special form for token=%d\n", tok); inp = sexp_read(secd, p); assert_cell(inp, "sexp_read: reading subexpression failed"); return new_cons(secd, new_symbol(secd, formname), new_cons(secd, inp, SECD_NIL)); } case '#': switch (tok = lexnext(p)) { case '(': { cell_t *tmplist = read_list(secd, p); if (p->token != ')') { free_cell(secd, tmplist); goto error_exit; } inp = list_to_vector(secd, tmplist); free_cell(secd, tmplist); return inp; } case TOK_SYM: { if (p->symtok[0] == '.') { int op = secdop_by_name(p->symtok + 1); if (op < 0) goto error_exit; return new_op(secd, op); } if (str_eq(p->symtok, "u8")) { lexnext(p); inp = read_bytevector(p); if (p->token != ')') goto error_exit; return inp; } } } errorf("Unknown suffix for #\n"); } error_exit: if (inp) free_cell(secd, inp); errorf("read_token: failed\n"); return new_error(secd, SECD_NIL, "read_token: failed on token %1$d '%1$c'", p->token); }
cell_t *new_strref(secd_t *secd, cell_t *mem, size_t size) { cell_t *ref = pop_free(secd); assert_cell(ref, "new_strref: allocation failed"); return init_strref(secd, ref, mem, size); }