Value Parser::arrayExpr(int top) {
consume('[');
if (TOKEN==']') {
consume(']');
return gc->EMPTY_ARRAY;
}
int slot = top++;
Array *array = Array::alloc(gc);
Value arrayValue = VAL_OBJ(array);
for (int pos = 0; ; ++pos) {
if (TOKEN == ']') { break; }
Value elem = expr(top);
if (IS_REG(elem)) {
if (!IS_REG(arrayValue)) {
emit(slot, MOVE, slot, arrayValue, UNUSED);
arrayValue = VAL_REG(slot);
}
emit(top+1, SETI, slot, VAL_NUM(pos), elem);
} else {
array->push(elem);
}
if (TOKEN == ']') { break; }
consume(',');
}
consume(']');
return arrayValue;
}
/**
* @brief list the directory contents stored in the array
* @param fpsockout socket file stream
* dirarray directory contents and the file info store
*
*/
void writebody(FILE *fpsockout, struct statdir **dirarray)
{
int i = 0;
char mtime[MAXDATELEN];
char size[MAXSIZELEN] = "";
char *name;
/* read from the array and if a file use FILFORMAT to write to the
* socket else if a directory use DIRFORMAT
*/
while ( dirarray[i] != NULL ) {
name = dirarray[i]->dir_ent->d_name;
fSize(size, dirarray[i]->statbuf->st_size);
modtime(mtime, dirarray[i]->statbuf->st_mtime);
if ( IS_REG(dirarray[i]->statbuf ) )
fprintf(fpsockout, FILFORMAT, name, name, mtime, size);
else if ( IS_DIR(dirarray[i]->statbuf ) )
fprintf(fpsockout, DIRFORMAT, name, name, mtime);
i++;
}
fflush(fpsockout);
}
const char *typeStr(Value v) {
const char *s = "?";
if (IS_NIL(v)) {
s = "nil";
} else if (IS_NUM(v)) {
s = "number";
} else if (IS_STRING(v)) {
s = "string";
} else if (IS_ARRAY(v)) {
s = "array";
} else if (IS_MAP(v)) {
s = "map";
} else if (IS_FUNC(v)) {
s = "func";
} else if (IS_CFUNC(v)) {
s = "cfunc";
} else if (IS_CF(v)) {
s = "cf";
} else if (IS_CP(v)) {
s = "cp";
} else if (IS_PROTO(v)) {
s = "proto";
} else if (IS_REG(v)) {
s = "reg";
}
return s;
}
bool Parser::statement() {
bool isReturn = false;
switch (lexer->token) {
case '{': isReturn = block(); break;
case TK_if: ifStat(); break;
case TK_while: whileStat(); break;
case TK_for: forStat(); break;
case TK_return: {
advance();
int top = syms->localsTop();
emit(top, RET, 0, expr(top), UNUSED);
isReturn = true;
break;
}
case TK_NAME: {
int lookahead = lexer->lookahead();
if (lookahead == '=' || lookahead == ':'+TK_EQUAL) {
Value name = lexer->info.name;
consume(TK_NAME);
if (lookahead == '=') {
int slot = lookupSlot(name);
consume('=');
int top = syms->localsTop();
patchOrEmitMove(top + 1, slot, expr(top));
proto->patchPos = -1;
} else {
consume(':'+TK_EQUAL);
if (syms->definedInThisBlock(name)) {
CERR(true, E_VAR_REDEFINITION, name);
// aSlot = slot; // reuse existing local with same name
} else {
const Value a = expr(syms->localsTop());
const int slot = syms->set(name);
patchOrEmitMove(slot+1, slot, a);
proto->patchPos = -1;
}
}
break;
}
}
default: {
int top = syms->localsTop();
Value lhs = expr(top);
if (TOKEN == '=') {
consume('=');
CERR(!IS_REG(lhs), E_ASSIGN_TO_CONST, lhs);
CERR(proto->patchPos < 0, E_ASSIGN_RHS, lhs);
unsigned code = proto->code.pop();
int op = OP(code);
CERR(op != GETI && op != GETF, E_ASSIGN_RHS, lhs);
assert((int)lhs == OC(code));
emit(top + 3, op + 1, OA(code), VAL_REG(OB(code)), expr(top + 2));
}
}
}
return isReturn;
}
static char ft_isexec(char *path)
{
struct stat sb;
if (!stat(path, &sb))
{
if (IS_REG(sb.st_mode) && sb.st_mode & 0111)
return (1);
}
return (0);
}
Value Parser::mapExpr(int top) {
consume('{');
if (TOKEN=='}') {
consume('}');
return gc->EMPTY_MAP;
}
int slot = top;
Map *map = Map::alloc(gc);
Value mapValue = VAL_OBJ(map);
for (int pos = 0; ; ++pos) {
if (TOKEN == '}') { break; }
Value k;
if (TOKEN == TK_NAME && lexer->lookahead() == '=') {
k = lexer->info.name;
consume(TK_NAME);
consume('=');
} else {
k = expr(top+1);
consume(':');
}
Value v = expr(topAbove(k, top+1));
if (IS_REG(k) || IS_REG(v)) {
if (!IS_REG(mapValue)) {
emit(slot, MOVE, slot, mapValue, UNUSED);
mapValue = VAL_REG(slot);
}
emit(top+2, SETI, slot, k, v);
} else {
map->indexSet(k, v);
}
if (TOKEN == '}') { break; }
consume(',');
}
consume('}');
return mapValue;
}
/*
* Enumerate new keyword
*/
void
_lex::_enum_keyword(void)
{
trace(
LEX_TRACE_ENABLE,
TRACE_ENTRY,
"lex::enum_keyword"
);
_typ = LEX_TOKEN_LABEL;
_txt += get_char();
if(next_char())
while(isalnum(get_char())
|| get_char() == UNDERSCORE) {
_txt += get_char();
if(has_next_char()) {
if(!next_char())
throw std::runtime_error(
_format_exception(
LEX_EXC_UNEXP_EOF,
get_line()
));
} else
break;
}
if(IS_REG(_txt))
_typ = LEX_TOKEN_REG_KEYWORD;
else if(IS_S_REG(_txt))
_typ = LEX_TOKEN_S_REG_KEYWORD;
else if(IS_STACK(_txt))
_typ = LEX_TOKEN_STACK_KEYWORD;
else if(IS_S_STACK(_txt))
_typ = LEX_TOKEN_S_STACK_KEYWORD;
else if(IS_B_OP(_txt))
_typ = LEX_TOKEN_B_OP_KEYWORD;
else if(IS_S_OP(_txt))
_typ = LEX_TOKEN_S_OP_KEYWORD;
else if(IS_P_PROC(_txt))
_typ = LEX_TOKEN_P_PROC_KEYWORD;
trace(
LEX_TRACE_ENABLE,
TRACE_EXIT,
"lex::enum_keyword"
);
}
void print_form(uptr_t form) {
if (IS_NIL(form)) {
printf_P(PSTR("()"));
} else if (IS_REG(form)) {
printf_P(PSTR("R:%p"), TO_PTR(form));
} else if (IS_INT(form)) {
printf_P(PSTR("%d"), TO_INT(form));
} else if (IS_SYM(form)) {
char buf[7];
memset(buf, 0, 7);
unhash_sym(buf, form);
printf_P(PSTR("%s"), buf);
} else {
printf_P(PSTR("("));
print_list(form);
printf_P(PSTR(")"));
}
}
static int topAbove(Value a, int top) {
return IS_REG(a) ? max((int)a + 1, top) : top;
}
uptr_t exec_special(uptr_t *env, uptr_t form) {
uptr_t fn = CAR(form);
uptr_t args = CDR(form);
switch(SVAL(fn)) {
case S_LET:
return let(env, args);
case S_FN:
return form;
case S_LOOP:
return loop(env, args);
case S_DO: {
uptr_t *body_p = refer(args), rval = NIL;
while (*body_p) {
rval = eval(env, CAR(*body_p));
*body_p = CDR(*body_p);
}
release(1); // body_p
return rval;
}
case S_RECUR: {
uptr_t rval, *fn_p = refer(fn);
rval = build_cons(*fn_p, eval_list(env, args));
release(1); // fn_p
return rval;
}
case S_QUOTE:
return CAR(args);
case S_CAR:
return CAR(eval(env, CAR(args)));
case S_CDR:
return CDR(eval(env, CAR(args)));
case S_AND: {
if (IS_NIL(args)) return PS_TRUE;
uptr_t *rem_args = refer(args),
rval = NIL;
while ((rval = eval(env, CAR(*rem_args))) && (*rem_args = CDR(*rem_args)));
release(1);
return rval;
}
case S_OR: {
if (IS_NIL(args)) return NIL;
uptr_t *rem_args = refer(args),
rval = NIL;
while (!(rval = eval(env, CAR(*rem_args))) && (*rem_args = CDR(*rem_args)));
release(1);
return rval;
}
case S_NOT: {
if (IS_NIL(args)) return NIL;
uptr_t rval = eval(env, CAR(args));
return rval ? NIL : PS_TRUE;
}
case S_IF: {
uptr_t rval = NIL, *clauses = refer(args);
if (eval(env, CAR(*clauses)) && CDR(*clauses))
rval = eval(env, CADR(*clauses));
else if (CDDR(*clauses))
rval = eval(env, CADDR(*clauses));
release(1); // clauses
return rval;
}
case S_WHEN: {
uptr_t rval = NIL, *cond_p = refer(CAR(args)), *body_p = refer(CDR(args));
if (eval(env, *cond_p))
while(*body_p) {
rval = eval(env, CAR(*body_p));
*body_p = CDR(*body_p);
}
release(2); // cond_p, body_p
return rval;
}
case S_CONS: {
uptr_t rval = NIL, *args_p = refer(args);
rval = build_cons(eval(env, CAR(*args_p)), eval(env, CADR(*args_p)));
release(1); // args_p
return rval;
}
case S_PRINT:
print_form(eval(env, CAR(args)));
printf_P(PSTR("\n"));
return NIL;
case S_DEF: {
uptr_t *args_p = refer(args),
*binding = refer(eval(env, CADR(args)));
assoc(env, CAR(*args_p), *binding);
release(2); // args_p, binding
return *binding; // Yeah, it's been "released", but the pointer is still valid.
}
case S_EVAL:
return eval(env, eval(env, CAR(args)));
#define _COMPR(rval) { \
if (IS_NIL(args)) return NIL; \
\
uptr_t *args_p = refer(args); \
while(CDR(*args_p) && (eval(env, CAR(*args_p)) _COMP_OPR eval(env, CADR(*args_p)))) \
*args_p = CDR(*args_p); \
\
if (IS_NIL(CDR(*args_p))) \
rval = eval(env, CAR(*args_p)); \
release(1); \
}
#define _COMP_OPR ==
case S_EQL: {
uptr_t rval = NIL;
_COMPR(rval);
return rval;
}
case S_NEQL: {
uptr_t rval = NIL;
_COMPR(rval);
return rval ? NIL : PS_TRUE;
}
#undef _COMP_OPR
#define _COMP_OPR <
case S_LT: {
uptr_t rval = NIL;
_COMPR(rval);
return rval;
}
#undef _COMP_OPR
#define _COMP_OPR <=
case S_LTE: {
uptr_t rval = NIL;
_COMPR(rval);
return rval;
}
#undef _COMP_OPR
#define _COMP_OPR >
case S_GT: {
uptr_t rval = NIL;
_COMPR(rval);
return rval;
}
#undef _COMP_OPR
#define _COMP_OPR >=
case S_GTE: {
uptr_t rval = NIL;
_COMPR(rval);
return rval;
}
#undef _COMP_OPR
#define _ARITH(coll) { \
uptr_t *rem_args = refer(args); \
coll = TO_INT(eval(env, CAR(*rem_args))); \
*rem_args = CDR(*rem_args); \
while (*rem_args) { \
coll _ARITH_OPR TO_INT(eval(env, CAR(*rem_args))); \
*rem_args = CDR(*rem_args); \
} \
release(1); \
}
#define _ARITH_OPR +=
case S_PLUS: {
if (! args) return INTERN_INT(0);
if (! CDR(args)) return eval(env, CAR(args));
int rval;
_ARITH(rval);
return INTERN_INT(rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR -=
case S_MINUS: {
if (! args) return NIL;
if (! CDR(args)) return INTERN_INT(0 - TO_INT(eval(env, CAR(args))));
int rval;
_ARITH(rval);
return INTERN_INT(rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR *=
case S_MULT: {
if (! args) return INTERN_INT(1);
if (! CDR(args)) return eval(env, CAR(args));
int rval;
_ARITH(rval);
return INTERN_INT(rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR /=
case S_DIV: {
if (! args) return NIL;
if (! CDR(args)) return INTERN_INT(eval(env, CAR(args)) == INTERN_INT(1) ? 1 : 0);
int rval;
_ARITH(rval);
return INTERN_INT(rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR &=
case S_BAND: {
if (! args) return NIL;
if (! CDR(args)) return eval(env, CAR(args));
uint8_t rval;
_ARITH(rval);
return INTERN_INT((int)rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR |=
case S_BOR: {
if (! args) return NIL;
if (! CDR(args)) return eval(env, CAR(args));
uint8_t rval;
_ARITH(rval);
return INTERN_INT((int)rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR ^=
case S_BXOR: {
if (! args) return NIL;
if (! CDR(args)) return eval(env, CAR(args));
uint8_t rval;
_ARITH(rval);
return INTERN_INT((int)rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR <<=
case S_BSL: {
if (! args) return NIL;
if (! CDR(args)) return eval(env, CAR(args));
uint8_t rval;
_ARITH(rval);
return INTERN_INT((int)rval);
}
#undef _ARITH_OPR
#define _ARITH_OPR >>=
case S_BSR: {
if (! args) return NIL;
if (! CDR(args)) return eval(env, CAR(args));
uint8_t rval;
_ARITH(rval);
return INTERN_INT((int)rval);
}
#undef _ARITH_OPR
case S_SREG: {
uptr_t *args_p = refer(args),
reg = eval(env, CAR(*args_p));
if (IS_REG(reg))
*BYTE_PTR(reg) = eval(env, CADR(*args_p));
else {
printf_P(PSTR("Invalid register: "));
print_form(reg);
printf_P(PSTR("\n"));
}
release(1); // args_p
return NIL;
}
case S_SLP:
_delay_ms(TO_INT(eval(env, CAR(args))));
return NIL;
default:
printf_P(PSTR("ERROR: "));
print_form(fn);
printf_P(PSTR(" is not a function.\n"));
return NIL;
}
}
