static inline
void* eval(const unsigned char value, tuple_t tuple,
const unsigned char **pc, Register *reg)
{
if (VAL_IS_HOST(value)) {
return (void*)EVAL_HOST;
} else if (VAL_IS_REG(value)) {
return (void*)&(reg[VAL_REG(value)]);
} else if (VAL_IS_TUPLE(value)) {
return (void*)tuple;
} else if (VAL_IS_FIELD(value)) {
const unsigned char reg_index = VAL_FIELD_REG(*pc);
const unsigned char field_num = VAL_FIELD_NUM(*pc);
tuple_t tuple = (tuple_t)MELD_CONVERT_REG_TO_PTR(reg[reg_index]);
(*pc) += 2;
#ifdef DEBUG_INSTRS
printf ("tuple = ");
tuple_print(tuple, stdout);
printf ("\n");
printf ("tuple[%d] = %lx\n", field_num, MELD_INT(GET_TUPLE_FIELD(tuple, field_num)));
#endif
return GET_TUPLE_FIELD(tuple, field_num);
} else if (VAL_IS_INT(value)) {
void *ret = (void *)(*pc);
*pc = *pc + sizeof(meld_int);
return ret;
} else if (VAL_IS_FLOAT(value)) {
void *ret = (void *)(*pc);
*pc = *pc + sizeof(meld_float);
return ret;
} else if (VAL_IS_REVERSE(value)) {
const int reg_index = VAL_FIELD_REG(*pc);
const int field_num = VAL_FIELD_NUM(*pc);
tuple_t tuple = (tuple_t)MELD_CONVERT_REG_TO_PTR(reg[reg_index]);
(*pc) += 2;
#ifdef PARALLEL_MACHINE
List *route = MELD_LIST(GET_TUPLE_FIELD(tuple, field_num));
List *clone = list_copy(route);
list_reverse_first(clone);
thread_self()->reverse_list = clone;
return (void *)&thread_self()->reverse_list;
#else
return GET_TUPLE_FIELD(tuple, field_num);
#endif /* PARALLEL_MACHINE */
} else {
assert(0 /* invalid value */ );
}
assert(0);
return NULL;
}
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;
}
static inline
void *eval_dst(const unsigned char value,
const unsigned char **pc, Register *reg, size_t *size)
{
if (VAL_IS_REG(value)) {
*size = sizeof(Register);
return &(reg)[VAL_REG(value)];
} else if (VAL_IS_FIELD(value)) {
int reg_index = VAL_FIELD_REG(*pc);
int field_num = VAL_FIELD_NUM(*pc);
tuple_t tuple = (tuple_t)MELD_CONVERT_REG_TO_PTR(reg[reg_index]);
tuple_type type = TUPLE_TYPE(tuple);
*size = TYPE_ARG_SIZE(type, field_num);
(*pc) += 2;
return GET_TUPLE_FIELD(tuple, field_num);
} else if (VAL_IS_INT(value)) {
assert(0);
} else if (VAL_IS_FLOAT(value)) {
assert(0);
} else if(VAL_IS_TUPLE(value)) {
assert(0);
} else if(VAL_IS_HOST(value)) {
assert(0);
} else {
assert(0 /* invalid value */ );
}
assert(0);
return NULL;
}
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;
}
void Parser::forStat() {
consume(TK_for);
syms->enterBlock(false);
CERR(TOKEN != TK_NAME, E_FOR_NAME, VNIL);
Value name = lexer->info.name;
int slot = syms->localsTop();
advance();
consume(':'+TK_EQUAL);
patchOrEmitMove(slot+2, slot+2, expr(slot+2));
consume(':');
patchOrEmitMove(slot+3, slot+1, expr(slot+3));
int pos1 = emitHole();
int pos2 = HERE;
syms->set(name, slot);
syms->addLocalsTop(2);
insideBlock();
emitJump(HERE, LOOP, VAL_REG(slot), pos2);
emitJump(pos1, FOR, VAL_REG(slot), HERE);
syms->exitBlock(false);
}
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;
}
int tuple_process(tuple_t tuple, unsigned char *pc,
int isNew, Register *reg)
{
for (; ; pc = advance(pc)) {
eval_loop: /* for jump instructions */
switch (0xf0 & *(const unsigned char*)pc) {
case 0x00: // some '8-bit' instruction
switch (0x0f & *(const unsigned char*)pc) {
case 0x00: // RETURN
#ifdef DEBUG_INSTRS
printf("RETURN\n");
#endif
return RET_RET;
break;
case 0x01: // NEXT
#ifdef DEBUG_INSTRS
printf("NEXT\n");
#endif
return RET_NEXT;
break;
case 0x02: // ELSE
fprintf(stderr, "ELSE NOT IMPLEMENTED YET!\n");
assert(0);
break;
case 0x08: // SEND
case 0x09: // SEND
case 0x0a: // SEND
case 0x0b: // SEND
{
const unsigned char *old_pc = pc+3;
Register send_reg = reg[SEND_MSG(pc)];
Register send_rt = reg[SEND_RT(pc)];
#ifdef DEBUG_INSTRS
printf("SEND\n");
#endif
tuple_send((tuple_t)MELD_CONVERT_REG_TO_PTR(send_reg),
MELD_CONVERT_REG_TO_PTR(send_rt),
MELD_INT(eval(SEND_DELAY(pc), &tuple, &old_pc, reg)), isNew);
break;
}
default:
fprintf(stderr, "INVALID INSTRUCTION %u", *pc);
assert(0);
break;
}
break;
case 0x20: // CALL
{
Register *dst = ®[CALL_DST(pc)];
Register args[CALL_ARGS(pc)];
assert(CALL_ARGS(pc) <= 5);
#ifdef DEBUG_INSTRS
printf("CALL %d (%d)\n", CALL_ID(pc), CALL_ARGS(pc));
#endif
int i;
const unsigned char *old_pc = pc+2;
for (i = 0; i < CALL_ARGS(pc); i++) {
unsigned char value = CALL_VAL(old_pc);
old_pc++;
args[i] = MELD_CONVERT_PTR_TO_REG(eval(value, &tuple, &old_pc, reg));
}
switch (CALL_ARGS(pc)) {
default:
break;
case 0:
*dst = CALL_FUNC(pc)();
break;
case 1:
*dst = CALL_FUNC(pc)(args[0]);
break;
case 2:
*dst = CALL_FUNC(pc)(args[0], args[1]);
break;
case 3:
*dst = CALL_FUNC(pc)(args[0], args[1], args[2]);
break;
case 4:
*dst = CALL_FUNC(pc)(args[0], args[1], args[2], args[3]);
break;
case 5:
*dst = CALL_FUNC(pc)(args[0], args[1], args[2], args[3], args[4]);
break;
}
break;
}
case 0x30: // MOVE
{
const unsigned char *old_pc = pc+2;
#ifdef DEBUG_INSTRS
{
char src = MOVE_SRC(pc);
char dst = MOVE_DST(pc);
printf("MOVE ");
if(VAL_IS_TUPLE(src))
printf("tuple");
else if(VAL_IS_REG(src))
printf("reg %d", VAL_REG(src));
else if(VAL_IS_HOST(src))
printf("host");
else if(VAL_IS_FIELD(src))
printf("FIELD");
else if(VAL_IS_INT(src))
printf("INT");
else if(VAL_IS_FLOAT(src))
printf("float");
else if(VAL_IS_REVERSE(src))
printf("reverse");
else printf("??");
printf(" ");
if(VAL_IS_TUPLE(dst))
printf("tuple");
else if(VAL_IS_REG(dst))
printf("reg %d", VAL_REG(dst));
else if(VAL_IS_HOST(dst))
printf("host");
else if(VAL_IS_FIELD(dst))
printf("FIELD");
else if(VAL_IS_INT(dst))
printf("INT");
else if(VAL_IS_FLOAT(dst))
printf("float");
else if(VAL_IS_REVERSE(dst))
printf("reverse");
else printf("??");
printf("\n");
}
#endif
size_t size = 0;
Register *src = eval(MOVE_SRC(pc), &tuple, &old_pc, reg);
Register *dst = eval_dst(MOVE_DST(pc), &old_pc, reg, &size);
memcpy(dst, src, size);
break;
}
case 0x40: // ALLOC
case 0x50: // ALLOC
{
const unsigned char *old_pc = pc+2;
tuple_t *dst;
#if defined(DEBUG_INSTRS) || defined(DEBUG_ALLOCS)
{
tuple_type type = ALLOC_TYPE(pc);
printf("ALLOC %s\n", tuple_names[type]);
}
#endif
dst = eval(ALLOC_DST(pc), &tuple, &old_pc, reg);
*dst = ALLOC_TUPLE(TYPE_SIZE(ALLOC_TYPE(pc)));
memset(*dst, 0, TYPE_SIZE(ALLOC_TYPE(pc)));
TUPLE_TYPE(*dst) = ALLOC_TYPE(pc);
break;
}
case 0x60: // IF
case 0x70: // IF
#ifdef DEBUG_INSTRS
printf("IF reg %d ", IF_REG(pc));
#endif
if (!reg[IF_REG(pc)]) {
#ifdef DEBUG_INSTRS
printf("no\n");
#endif
pc += IF_JUMP(pc);
goto eval_loop;
}
#ifdef DEBUG_INSTRS
printf("yes\n");
#endif
break;
case 0x80: // REMOVE
case 0x90: // REMOVE
if (isNew > 0) {
int reg_remove = REMOVE_REG(pc);
int size = TYPE_SIZE(TUPLE_TYPE(MELD_CONVERT_REG_TO_PTR(reg[reg_remove])));
tuple_handle(memcpy(malloc(size),MELD_CONVERT_REG_TO_PTR(reg[reg_remove]), size), -1, reg);
reg[REMOVE_REG(pc)] = 0;
}
break;
case 0xa0: // ITER
{
const tuple_type type = ITER_TYPE(pc);
int i, length;
void **list;
unsigned char *jump = pc + ITER_JUMP(pc);
int size = TYPE_SIZE(type);
/* produce a random ordering for all tuples of the appropriate type */
if(TYPE_IS_PERSISTENT(type) && !TYPE_IS_AGG(type)) {
/* persistent aggregate types not supported */
persistent_set *persistents = &PERSISTENT[type];
length = persistents->current;
list = malloc(sizeof(tuple_t) * length);
for(i = 0; i < length; i++) {
int j = random() % (i + 1);
list[i] = list[j];
list[j] = persistents->array + i * size;
}
} else {
/* non-persistent type */
tuple_entry *entry = TUPLES[type].head;
length = queue_length(&TUPLES[ITER_TYPE(pc)]);
list = malloc(sizeof(tuple_t) * length);
for (i = 0; i < length; i++) {
int j = random() % (i+1);
list[i] = list[j];
list[j] = entry->tuple;
entry = entry->next;
}
}
#ifdef DEBUG_INSTRS
printf("ITER %s len=%d\n", tuple_names[type], length);
#endif
if(length == 0) {
/* no need to execute any further code, just jump! */
pc = jump;
goto eval_loop;
}
/* iterate over all tuples of the appropriate type */
void *next_tuple;
for (i = 0; i < length; i++) {
next_tuple = list[i];
unsigned char matched = 1;
const unsigned char *tmppc;
tmppc = pc + ITER_BASE;
if(!ITER_MATCH_NONE(tmppc)) {
/* check to see if it matches */
while (1) {
const unsigned char *old_pc = tmppc + 2;
const unsigned char fieldnum = ITER_MATCH_FIELD(tmppc);
const unsigned char type_size = TYPE_ARG_SIZE(type, fieldnum);
Register *field = GET_TUPLE_FIELD(next_tuple, fieldnum);
Register *val = eval(ITER_MATCH_VAL(tmppc), &tuple, &old_pc, reg);
matched = matched && (memcmp(field, val, type_size) == 0);
if(ITER_MATCH_END(tmppc))
break;
tmppc = old_pc;
}
}
#ifdef DEBUG_INSTRS
printf("MATCHED: %d %d\n", matched, length);
#endif
if (matched) {
if (RET_RET == tuple_process(next_tuple, advance(pc), isNew, reg)) {
free(list);
return RET_RET;
}
}
}
free(list);
/* advance the pc to the end of the loop */
pc = jump;
goto eval_loop;
break;
}
case 0xc0: // OP
case 0xd0: // OP
case 0xe0: // OP
case 0xf0: // OP
{
const unsigned char *old_pc = pc+3;
#ifdef DEBUG_INSTRS
printf("OP to %d\n", OP_DST(pc));
#endif
Register *arg1, *arg2;
arg1 = eval(OP_ARG1(pc), &tuple, &old_pc, reg);
arg2 = eval(OP_ARG2(pc), &tuple, &old_pc, reg);
#ifdef DEBUG_INSTRS
printf ("%ld", MELD_INT(arg1));
printf ("OP");
printf ("%ld", MELD_INT(arg2));
printf ("\n");
#endif
Register *dest = reg + OP_DST(pc);
switch(OP_OP(pc)) {
case OP_NEQI: *dest = (MELD_INT(arg1) != MELD_INT(arg2)); break;
case OP_EQI: *dest = (MELD_INT(arg1) == MELD_INT(arg2)); break;
case OP_LESSI: *dest = (MELD_INT(arg1) < MELD_INT(arg2)); break;
case OP_LESSEQI: *dest = (MELD_INT(arg1) <= MELD_INT(arg2)); break;
case OP_GREATERI: *dest = (MELD_INT(arg1) > MELD_INT(arg2)); break;
case OP_GREATEREQI: *dest = (MELD_INT(arg1) >= MELD_INT(arg2)); break;
case OP_MODI: MELD_INT(dest) = (MELD_INT(arg1) % MELD_INT(arg2)); break;
case OP_PLUSI: MELD_INT(dest) = (MELD_INT(arg1) + MELD_INT(arg2)); break;
case OP_MINUSI: MELD_INT(dest) = (MELD_INT(arg1) - MELD_INT(arg2)); break;
case OP_TIMESI: MELD_INT(dest) = (MELD_INT(arg1) * MELD_INT(arg2)); break;
case OP_DIVI: MELD_INT(dest) = (MELD_INT(arg1) / MELD_INT(arg2)); break;
case OP_NEQF: *dest = (MELD_FLOAT(arg1) != MELD_FLOAT(arg2)); break;
case OP_EQF: *dest = (MELD_FLOAT(arg1) == MELD_FLOAT(arg2)); break;
case OP_LESSF: *dest = (MELD_FLOAT(arg1) < MELD_FLOAT(arg2)); break;
case OP_LESSEQF: *dest = (MELD_FLOAT(arg1) <= MELD_FLOAT(arg2)); break;
case OP_GREATERF: *dest = (MELD_FLOAT(arg1) > MELD_FLOAT(arg2)); break;
case OP_GREATEREQF: *dest = (MELD_FLOAT(arg1) >= MELD_FLOAT(arg2)); break;
case OP_MODF: MELD_FLOAT(dest) = fmod(MELD_FLOAT(arg1), MELD_FLOAT(arg2)); break;
case OP_PLUSF: MELD_FLOAT(dest) = (MELD_FLOAT(arg1) + MELD_FLOAT(arg2)); break;
case OP_MINUSF: MELD_FLOAT(dest) = (MELD_FLOAT(arg1) - MELD_FLOAT(arg2)); break;
case OP_TIMESF: MELD_FLOAT(dest) = (MELD_FLOAT(arg1) * MELD_FLOAT(arg2)); break;
case OP_DIVF: MELD_FLOAT(dest) = (MELD_FLOAT(arg1) / MELD_FLOAT(arg2)); break;
case OP_NEQA: *dest = (MELD_PTR(arg1) != MELD_PTR(arg2)); break;
case OP_EQA: *dest = (MELD_PTR(arg1) == MELD_PTR(arg2)); break;
}
break;
}
default:
fprintf(stderr, "INVALID INSTRUCTION %u", *pc);
assert(0);
break;
}
}
return RET_RET;
}
