int main(int argc, char *argv[]) {
secd_t secd;
cell_t *heap = (cell_t *)malloc(sizeof(cell_t) * N_CELLS);
init_secd(&secd, heap, N_CELLS);
#if ((CTRLDEBUG) || (MEMDEBUG))
secd_setport(&secd, SECD_STDDBG, secd_fopen(&secd, "secd.log", "w"));
#endif
cell_t *cmdport = SECD_NIL;
if (argc == 2)
cmdport = secd_fopen(&secd, argv[1], "r");
cell_t *inp = sexp_parse(&secd, cmdport); // cmdport is dropped after
if (is_nil(inp) || !is_cons(inp)) {
secd_errorf(&secd, "list of commands expected\n");
dbg_printc(&secd, inp);
return 1;
}
cell_t *ret;
ret = run_secd(&secd, inp);
return (is_error(ret) ? EXIT_FAILURE : EXIT_SUCCESS);
}
inline static token_t lexsymbol(secd_parser_t *p) {
char *s = p->symtok;
size_t read_count = 1;
do {
*s++ = p->lc;
nextchar(p);
if (++read_count >= MAX_LEXEME_SIZE) {
*s = '\0';
secd_errorf(p->secd, "lexnext: lexeme is too large: %s\n", p->symtok);
return (p->token = TOK_ERR);
}
} while (p->issymbc[(unsigned char)p->lc]);
*s = '\0';
/* try to convert symbol into number */
if (p->symtok[0] == '-' || p->symtok[0] == '+') {
char *end = NULL;
p->numtok = (int)strtol(p->symtok, &end, 10);
if ((p->symtok[0] != '\0') && (end[0] == '\0'))
return (p->token = TOK_NUM);
}
return (p->token = TOK_SYM);
}
inline static token_t lexstring(secd_parser_t *p) {
size_t bufsize = 32; /* initial size since string size is not limited */
size_t read_count = 0;
/* to be freed after p->strtok is consumed: */
cell_t *strbuf = new_string_of_size(p->secd, bufsize);
share_cell(p->secd, strbuf);
char *buf = strmem(strbuf);
while (1) {
nextchar(p);
switch (p->lc) {
case '\\':
nextchar(p);
switch (p->lc) {
case 'a' : buf[read_count++] = '\x07'; break;
case 'b' : buf[read_count++] = '\x08'; break;
case 't' : buf[read_count++] = '\x09'; break;
case 'n' : buf[read_count++] = '\x0A'; break;
case 'x': {
char hexbuf[10];
char *hxb = hexbuf;
nextchar(p);
if (!isxdigit(p->lc))
goto cleanup_and_exit;
do {
*hxb++ = p->lc;
nextchar(p);
} while ((hxb - hexbuf < 9) && isxdigit(p->lc));
if (p->lc != ';')
goto cleanup_and_exit;
*hxb = '\0';
unichar_t charcode = (int)strtol(hexbuf, NULL, 16);
char *after = utf8cpy(buf + read_count, charcode);
if (!after)
goto cleanup_and_exit;
read_count = after - buf;
} break;
default:
buf[read_count++] = p->lc;
}
break;
case '"':
nextchar(p);
buf[read_count] = '\0';
p->strtok = strbuf; /* don't forget to free */
return (p->token = TOK_STR);
default:
buf[read_count] = p->lc;
++read_count;
}
if (read_count + 4 >= bufsize) { // +4 because of utf8cpy
/* reallocate */
size_t newbufsize = 2 * bufsize;
cell_t *newstrbuf = new_string_of_size(p->secd, newbufsize);
if (is_error(newstrbuf)) {
secd_errorf(p->secd, "lexstring: not enough memory for a string\n");
goto cleanup_and_exit;
}
//errorf(";# reallocating string to %lu", newbufsize);
char *newbuf = strmem(newstrbuf);
memcpy(newbuf, buf, bufsize);
assign_cell(p->secd, &strbuf, newstrbuf);
buf = newbuf;
bufsize = newbufsize;
}
}
cleanup_and_exit:
drop_cell(p->secd, strbuf);
return (p->token = TOK_ERR);
}
