예제 #1
0
void sexp_print_array(secd_t *secd, cell_t *p, const cell_t *cell) {
    const cell_t *arr = arr_val(cell, 0);
    const size_t len = arr_size(secd, cell);
    size_t i;

    secd_pprintf(secd, p, "#(");
    for (i = cell->as.arr.offset; i < len; ++i) {
        sexp_pprint(secd, p, arr + i);
        secd_pprintf(secd, p, " ");
    }
    secd_pprintf(secd, p, ")");
}
예제 #2
0
void dbg_print_cell(secd_t *secd, const cell_t *c) {
    if (is_nil(c)) {
         secd_printf(secd, "NIL\n");
         return;
    }
    char buf[128];
    if (c->nref > DONT_FREE_THIS - 100000) strncpy(buf, "-", 64);
    else snprintf(buf, 128, "%ld", (long)c->nref);
    printf("[%ld]^%s: ", cell_index(secd, c), buf);

    switch (cell_type(c)) {
      case CELL_CONS:
        printf("CONS([%ld], [%ld])\n",
               cell_index(secd, get_car(c)), cell_index(secd, get_cdr(c)));
        break;
      case CELL_FRAME:
        printf("FRAME(syms: [%ld], vals: [%ld])\n",
               cell_index(secd, get_car(c)), cell_index(secd, get_cdr(c)));
        break;
      case CELL_INT:  printf("%d\n", c->as.num); break;
      case CELL_CHAR:
        if (isprint(c->as.num)) printf("#\\%c\n", (char)c->as.num);
        else printf("#x%x\n", c->as.num);
        break;
      case CELL_OP:
        sexp_print_opcode(secd, secd->output_port, c->as.op);
        printf("\n");
        break;
      case CELL_FUNC: printf("*%p()\n", c->as.ptr); break;
      case CELL_KONT: printf("KONT[%ld, %ld, %ld]\n",
                             cell_index(secd, c->as.kont.stack),
                             cell_index(secd, c->as.kont.env),
                             cell_index(secd, c->as.kont.ctrl)); break;
      case CELL_ARRAY: printf("ARR[%ld]\n",
                               cell_index(secd, arr_val(c, 0))); break;
      case CELL_STR: printf("STR[%ld\n",
                             cell_index(secd, (cell_t*)strval(c))); break;
      case CELL_SYM: printf("SYM[%08x]='%s'\n",
                             symhash(c), symname(c)); break;
      case CELL_BYTES: printf("BVECT[%ld]\n",
                               cell_index(secd, (cell_t*)strval(c))); break;
      case CELL_REF: printf("REF[%ld]\n",
                             cell_index(secd, c->as.ref)); break;
      case CELL_ERROR: printf("ERR[%s]\n", errmsg(c)); break;
      case CELL_ARRMETA: printf("META[%ld, %ld]\n",
                                 cell_index(secd, mcons_prev((cell_t*)c)),
                                 cell_index(secd, mcons_next((cell_t*)c))); break;
      case CELL_UNDEF: printf("#?\n"); break;
      case CELL_FREE: printf("FREE\n"); break;
      default: printf("unknown type: %d\n", cell_type(c));
    }
}
예제 #3
0
파일: machine.c 프로젝트: EarlGray/SECD
cell_t *serialize_cell(secd_t *secd, cell_t *cell) {
    cell_t *opt = SECD_NIL;
    switch (cell_type(cell)) {
    case CELL_CONS: {
        cell_t *cdrc = chain_index(secd, get_cdr(cell), SECD_NIL);
        opt = chain_index(secd, get_car(cell), cdrc);
    }
    break;
    case CELL_PORT:
        opt = secd_pserialize(secd, cell);
        break;
    case CELL_SYM:
        opt = new_cons(secd, cell, SECD_NIL);
        break;
    case CELL_INT:
    case CELL_CHAR:
        opt = new_cons(secd, cell, SECD_NIL);
        break;
    case CELL_OP: {
        cell_t *namec = new_symbol(secd, opcode_table[ cell->as.op ].name);
        opt = new_cons(secd, namec, SECD_NIL);
    }
    break;
    case CELL_FUNC:
        opt = new_cons(secd, new_number(secd, (long)cell->as.ptr), SECD_NIL);
        break;
    case CELL_ARRMETA: {
        cell_t *typec = chain_sym(secd,
                                  (cell->as.mcons.cells ? "cell" : "byte"),
                                  SECD_NIL);
        cell_t *nextc = chain_index(secd, mcons_next(cell), typec);
        opt = chain_index(secd, mcons_prev(cell), nextc);
    }
    break;
    case CELL_FRAME: {
        cell_t *ioc = chain_index(secd, cell->as.frame.io, SECD_NIL);
        cell_t *nextc = chain_index(secd, cell->as.frame.cons.cdr, ioc);
        opt = chain_index(secd, cell->as.frame.cons.car, nextc);
    }
    break;
    case CELL_KONT: {
        cell_t *kctrl = chain_index(secd, cell->as.kont.ctrl, SECD_NIL);
        cell_t *kenv  = chain_index(secd, cell->as.kont.env,  kctrl);
        opt = chain_index(secd, cell->as.kont.stack, kenv);
    }
    break;
    case CELL_FREE: {
        cell_t *nextc = chain_index(secd, get_cdr(cell), SECD_NIL);
        opt = chain_index(secd, get_car(cell), nextc);
    }
    break;
    case CELL_REF:
        opt = chain_index(secd, cell->as.ref, SECD_NIL);
        break;
    case CELL_ERROR:
        opt = chain_string(secd, errmsg(cell), SECD_NIL);
        break;
    case CELL_UNDEF:
        opt = SECD_NIL;
        break;
    case CELL_ARRAY:
        opt = chain_index(secd, arr_val(cell, -1), SECD_NIL);
        break;
    case CELL_STR:
    case CELL_BYTES:
        opt = chain_index(secd, arr_meta((cell_t *)strmem(cell)), SECD_NIL);
        break;
    }
    opt = new_cons(secd, secd_type_sym(secd, cell), opt);
    cell_t *refc = new_cons(secd, new_number(secd, cell->nref), opt);
    return new_cons(secd, new_number(secd, cell - secd->begin), refc);
}