static void vm_loop(su_state *s, function_t *func) {
value_t tmpv, tmpv2;
instruction_t inst;
int tmp, narg, i, j, k;
const char *tmpcs;
su_debug_data dbg;
s->frame = FRAME();
s->prot = func->prot;
#define ARITH_OP(op) \
su_check_type(s, -2, SU_NUMBER); \
su_check_type(s, -1, SU_NUMBER); \
STK(-2)->obj.num = STK(-2)->obj.num op STK(-1)->obj.num; \
su_pop(s, 1); \
break;
#define LOG_OP(op) \
su_check_type(s, -2, SU_NUMBER); \
su_check_type(s, -1, SU_NUMBER); \
STK(-2)->type = SU_BOOLEAN; \
STK(-2)->obj.b = STK(-2)->obj.num op STK(-1)->obj.num; \
su_pop(s, 1); \
break;
for (s->pc = 0; s->pc < s->prot->num_inst; s->pc++) {
tmp = s->interrupt | atomic_get(&s->msi->interrupt);
if (tmp) {
if ((tmp & ISCOLLECT) == ISCOLLECT) {
su_thread_indisposable(s);
su_thread_disposable(s);
}
if ((tmp & IGC) == IGC) {
unmask_thread_interrupt(s, IGC);
gc_trace(s);
}
if ((tmp & IBREAK) == IBREAK) {
unmask_thread_interrupt(s, IBREAK);
dbg.file = s->prot->name->str;
dbg.line = s->prot->lineinf[s->pc];
s->debug_cb(s, &dbg, s->debug_cb_data);
}
}
inst = s->prot->inst[s->pc];
switch (inst.id) {
case OP_PUSH:
push_value(s, &func->constants[inst.a]);
break;
case OP_POP:
su_pop(s, inst.a);
break;
case OP_ADD: ARITH_OP(+)
case OP_SUB: ARITH_OP(-)
case OP_MUL: ARITH_OP(*)
case OP_DIV:
su_check_type(s, -2, SU_NUMBER);
su_check_type(s, -1, SU_NUMBER);
su_assert(s, STK(-1)->obj.num != 0.0, "Division by zero!");
STK(-2)->obj.num = STK(-2)->obj.num / STK(-1)->obj.num;
su_pop(s, 1);
break;
case OP_MOD:
su_check_type(s, -2, SU_NUMBER);
su_check_type(s, -1, SU_NUMBER);
STK(-2)->obj.num = (double)((int)STK(-2)->obj.num % (int)STK(-1)->obj.num);
su_pop(s, 1);
break;
case OP_POW:
su_check_type(s, -2, SU_NUMBER);
su_check_type(s, -1, SU_NUMBER);
STK(-2)->obj.num = pow(STK(-2)->obj.num, STK(-1)->obj.num);
su_pop(s, 1);
break;
case OP_UNM:
su_check_type(s, -1, SU_NUMBER);
STK(-1)->obj.num = -STK(-1)->obj.num;
break;
case OP_EQ:
STK(-2)->obj.b = value_eq(STK(-2), STK(-1));
STK(-2)->type = SU_BOOLEAN;
su_pop(s, 1);
break;
case OP_LESS: LOG_OP(<);
case OP_LEQUAL: LOG_OP(<=);
case OP_NOT:
if (STK(-1)->type == SU_BOOLEAN) {
STK(-1)->obj.b = !STK(-1)->obj.b;
} else {
STK(-1)->obj.b = (STK(-1)->type == SU_NIL) ? 1 : 0;
STK(-1)->type = SU_BOOLEAN;
}
break;
case OP_AND:
tmp = STK(-2)->type != SU_NIL && (STK(-2)->type != SU_BOOLEAN || STK(-2)->obj.b);
if (tmp && STK(-1)->type != SU_NIL && (STK(-1)->type != SU_BOOLEAN || STK(-1)->obj.b)) {
s->stack[s->stack_top - 2] = *STK(-1);
} else {
STK(-2)->obj.b = 0;
STK(-2)->type = SU_BOOLEAN;
}
su_pop(s, 1);
break;
case OP_OR:
if (STK(-2)->type != SU_NIL && (STK(-2)->type != SU_BOOLEAN || STK(-2)->obj.b)) {
/* return -2 */
} else if (STK(-1)->type != SU_NIL && (STK(-1)->type != SU_BOOLEAN || STK(-1)->obj.b)) {
s->stack[s->stack_top - 2] = *STK(-1);
} else {
STK(-2)->obj.b = 0;
STK(-2)->type = SU_BOOLEAN;
}
su_pop(s, 1);
break;
case OP_TEST:
if (STK(-1)->type != SU_NIL && (STK(-1)->type != SU_BOOLEAN || STK(-1)->obj.b))
s->pc = inst.b - 1;
su_pop(s, 1);
break;
case OP_FOR:
if (STK(-2)->type == SU_NIL) {
su_swap(s, -2, -1);
s->stack_top--;
s->pc = inst.b - 1;
} else {
s->stack_top--;
su_check_type(s, -1, SU_SEQ);
su_rest(s, -1);
su_swap(s, -2, -1);
su_first(s, -1);
su_swap(s, -2, -1);
s->stack_top--;
}
break;
case OP_JMP:
s->pc = inst.b - 1;
break;
case OP_RETURN:
s->pc = s->frame->ret_addr - 1;
s->prot = s->frame->func->prot;
func = s->frame->func;
s->stack[s->frame->stack_top] = *STK(-1);
s->stack_top = s->frame->stack_top + 1;
s->frame_top--;
s->frame = FRAME();
break;
case OP_TCALL:
s->pc = s->frame->ret_addr - 1;
s->prot = s->frame->func->prot;
func = s->frame->func;
memmove(&s->stack[s->frame->stack_top], &s->stack[s->stack_top - (inst.a + 1)], sizeof(value_t) * (inst.a + 1));
s->stack_top = s->frame->stack_top + inst.a + 1;
s->frame_top--;
s->frame = FRAME();
/* Do a normal call. */
case OP_CALL:
tmp = s->stack_top - inst.a - 1;
switch (s->stack[tmp].type) {
case SU_FUNCTION:
s->frame = &s->frames[s->frame_top++];
assert(s->frame_top <= MAX_CALLS);
s->frame->ret_addr = s->pc + 1;
s->frame->func = func;
s->frame->stack_top = tmp;
func = s->stack[tmp].obj.func;
if (func->narg < 0)
su_vector(s, inst.a);
else if (func->narg != inst.a)
su_error(s, "Bad number of arguments to function! Expected %i, but got %i.", (int)func->narg, (int)inst.a);
s->prot = func->prot;
s->pc = -1;
break;
case SU_NATIVEFUNC:
narg = s->narg;
s->narg = inst.a;
if (s->stack[tmp].obj.nfunc(s, inst.a)) {
s->stack[tmp] = *STK(-1);
} else {
s->stack[tmp].type = SU_NIL;
}
s->stack_top = tmp + 1;
s->narg = narg;
break;
case SU_VECTOR:
if (inst.a == 1) {
su_check_type(s, -1, SU_NUMBER);
tmpv = vector_index(s, s->stack[tmp].obj.vec, su_tointeger(s, -1));
su_pop(s, 2);
push_value(s, &tmpv);
} else {
for (i = -inst.a, j = 0; i; i++, j++) {
su_check_type(s, i - j, SU_NUMBER);
tmpv = vector_index(s, s->stack[tmp].obj.vec, su_tointeger(s, i - j));
push_value(s, &tmpv);
}
su_vector(s, inst.a);
s->stack[tmp] = s->stack[s->stack_top - 1];
s->stack_top -= inst.a + 1;
}
break;
case SU_MAP:
if (inst.a == 1) {
tmpv2 = *STK(-1);
tmpv = map_get(s, s->stack[tmp].obj.m, &tmpv2, hash_value(&tmpv2));
su_assert(s, tmpv.type != SU_INV, "No value with key: %s", stringify(s, &tmpv2));
su_pop(s, 2);
push_value(s, &tmpv);
} else {
for (i = -inst.a, j = 0; i; i++, j += 2) {
tmpv2 = *STK(i - j);
push_value(s, &tmpv2);
tmpv = map_get(s, s->stack[tmp].obj.m, &tmpv2, hash_value(&tmpv2));
su_assert(s, tmpv.type != SU_INV, "No value with key: %s", stringify(s, &tmpv2));
push_value(s, &tmpv);
}
su_map(s, inst.a);
s->stack[tmp] = s->stack[s->stack_top - 1];
s->stack_top -= inst.a + 1;
}
break;
case SU_STRING:
if (inst.a == 1) {
su_check_type(s, -1, SU_NUMBER);
j = su_tointeger(s, -1);
su_assert(s, j < s->stack[tmp].obj.str->size, "Out of range!");
s->scratch_pad[0] = s->stack[tmp].obj.str->str[j];
su_pop(s, 2);
su_pushbytes(s, s->scratch_pad, 1);
} else {
k = 0;
for (i = -inst.a; i; i++) {
su_check_type(s, i, SU_NUMBER);
j = su_tointeger(s, i);
su_assert(s, j < s->stack[tmp].obj.str->size, "Out of range!");
s->scratch_pad[k++] = s->stack[tmp].obj.str->str[j];
assert(k < SU_SCRATCHPAD_SIZE);
}
su_pushbytes(s, s->scratch_pad, k);
s->stack[tmp] = s->stack[s->stack_top - 1];
s->stack_top -= inst.a + 1;
}
break;
case SU_NATIVEDATA:
tmpv = s->stack[tmp];
if (tmpv.obj.data->vt && tmpv.obj.data->vt->call) {
narg = s->narg;
s->narg = inst.a;
if (tmpv.obj.data->vt->call(s, (void*)tmpv.obj.data->data, inst.a))
s->stack[tmp] = *STK(-1);
else
s->stack[tmp].type = SU_NIL;
s->stack_top = tmp + 1;
s->narg = narg;
break;
}
default:
if (inst.a == 1 && isseq(s, &s->stack[tmp])) {
su_check_type(s, -1, SU_STRING);
tmpcs = su_tostring(s, -1, NULL);
if (!strcmp(tmpcs, "first")) {
s->stack[(--s->stack_top) - 1] = seq_first(s, STK(-1)->obj.q);
break;
} else if (!strcmp(tmpcs, "rest")) {
s->stack[(--s->stack_top) - 1] = seq_rest(s, STK(-1)->obj.q);
break;
}
}
su_error(s, "Can't apply '%s'.", type_name(s->stack[tmp].type));
}
break;
case OP_LAMBDA:
assert(inst.a < s->prot->num_prot);
lambda(s, &s->prot->prot[inst.a], inst.b);
break;
case OP_GETGLOBAL:
tmpv = func->constants[inst.a];
su_assert(s, tmpv.type == SU_STRING, "Global key must be a string!");
tmpv = map_get(s, unref_local(s, s->stack[SU_GLOBAL_INDEX].obj.loc).obj.m, &tmpv, hash_value(&tmpv));
if (tmpv.type == SU_INV)
global_error(s, "Undefined global variable", &func->constants[inst.a]);
push_value(s, &tmpv);
break;
case OP_SETGLOBAL:
tmpv = func->constants[inst.a];
su_assert(s, tmpv.type == SU_STRING, "Global key must be a string!");
i = hash_value(&tmpv);
tmpv2 = unref_local(s, s->stack[SU_GLOBAL_INDEX].obj.loc);
tmpv = map_insert(s, tmpv2.obj.m, &tmpv, i, STK(-1));
set_local(s, s->stack[SU_GLOBAL_INDEX].obj.loc, &tmpv);
break;
case OP_SHIFT:
s->stack[s->stack_top - (inst.a + 1)] = *STK(-1);
s->stack_top -= inst.a;
break;
case OP_LOAD:
assert(FRAME()->stack_top + inst.a < s->stack_top);
push_value(s, &s->stack[FRAME()->stack_top + inst.a]);
break;
case OP_LUP:
assert(inst.a < func->num_ups);
push_value(s, &func->upvalues[inst.a]);
break;
case OP_LCL:
assert(inst.b < s->msi->num_c_lambdas);
push_value(s, &s->msi->c_lambdas[inst.b]);
break;
default:
assert(0);
}
#undef ARITH_OP
#undef LOG_OP
}
}
/**
* Tests Constraints_fullDimensionize by comparing the Ehrhart polynomials
* @param A the input set of constraints
* @param B the corresponding context
* @param the number of samples to generate for the test
* @return 1 if the Ehrhart polynomial had the same value for the
* full-dimensional and non-full-dimensional sets of constraints, for their
* corresponding sample parameters values.
*/
int test_Constraints_fullDimensionize(Matrix * A, Matrix * B,
unsigned int nbSamples) {
Matrix * Eqs= NULL, *ParmEqs=NULL, *VL=NULL;
unsigned int * elimVars=NULL, * elimParms=NULL;
Matrix * sample, * smallerSample=NULL;
Matrix * transfSample=NULL;
Matrix * parmVL=NULL;
unsigned int i, j, r, nbOrigParms, nbParms;
Value div, mod, *origVal=NULL, *fullVal=NULL;
Matrix * VLInv;
Polyhedron * P, *PC;
Matrix * M, *C;
Enumeration * origEP, * fullEP=NULL;
const char **fullNames = NULL;
int isOk = 1; /* holds the result */
/* compute the origial Ehrhart polynomial */
M = Matrix_Copy(A);
C = Matrix_Copy(B);
P = Constraints2Polyhedron(M, maxRays);
PC = Constraints2Polyhedron(C, maxRays);
origEP = Polyhedron_Enumerate(P, PC, maxRays, origNames);
Matrix_Free(M);
Matrix_Free(C);
Polyhedron_Free(P);
Polyhedron_Free(PC);
/* compute the full-dimensional polyhedron corresponding to A and its Ehrhart
polynomial */
M = Matrix_Copy(A);
C = Matrix_Copy(B);
nbOrigParms = B->NbColumns-2;
Constraints_fullDimensionize(&M, &C, &VL, &Eqs, &ParmEqs,
&elimVars, &elimParms, maxRays);
if ((Eqs->NbRows==0) && (ParmEqs->NbRows==0)) {
Matrix_Free(M);
Matrix_Free(C);
Matrix_Free(Eqs);
Matrix_Free(ParmEqs);
free(elimVars);
free(elimParms);
return 1;
}
nbParms = C->NbColumns-2;
P = Constraints2Polyhedron(M, maxRays);
PC = Constraints2Polyhedron(C, maxRays);
namesWithoutElim(origNames, nbOrigParms, elimParms, &fullNames);
fullEP = Polyhedron_Enumerate(P, PC, maxRays, fullNames);
Matrix_Free(M);
Matrix_Free(C);
Polyhedron_Free(P);
Polyhedron_Free(PC);
/* make a set of sample parameter values and compare the corresponding
Ehrhart polnomials */
sample = Matrix_Alloc(1,nbOrigParms);
transfSample = Matrix_Alloc(1, nbParms);
Lattice_extractSubLattice(VL, nbParms, &parmVL);
VLInv = Matrix_Alloc(parmVL->NbRows, parmVL->NbRows+1);
MatInverse(parmVL, VLInv);
if (dbg) {
show_matrix(parmVL);
show_matrix(VLInv);
}
srand(nbSamples);
value_init(mod);
value_init(div);
for (i = 0; i< nbSamples; i++) {
/* create a random sample */
for (j=0; j< nbOrigParms; j++) {
value_set_si(sample->p[0][j], rand()%100);
}
/* compute the corresponding value for the full-dimensional
constraints */
valuesWithoutElim(sample, elimParms, &smallerSample);
/* (N' i' 1)^T = VLinv.(N i 1)^T*/
for (r = 0; r < nbParms; r++) {
Inner_Product(&(VLInv->p[r][0]), smallerSample->p[0], nbParms,
&(transfSample->p[0][r]));
/* add the constant part */
value_addto(transfSample->p[0][r], transfSample->p[0][r],
VLInv->p[r][VLInv->NbColumns-2]);
value_pdivision(div, transfSample->p[0][r],
VLInv->p[r][VLInv->NbColumns-1]);
value_subtract(mod, transfSample->p[0][r], div);
/* if the parameters value does not belong to the validity lattice, the
Ehrhart polynomial is zero. */
if (!value_zero_p(mod)) {
fullEP = Enumeration_zero(nbParms, maxRays);
break;
}
}
/* compare the two forms of the Ehrhart polynomial.*/
if (origEP ==NULL) break; /* NULL has loose semantics for EPs */
origVal = compute_poly(origEP, sample->p[0]);
fullVal = compute_poly(fullEP, transfSample->p[0]);
if (!value_eq(*origVal, *fullVal)) {
isOk = 0;
printf("EPs don't match. \n Original value = ");
value_print(stdout, VALUE_FMT, *origVal);
printf("\n Original sample = [");
for (j=0; j<sample->NbColumns; j++) {
value_print(stdout, VALUE_FMT, sample->p[0][j]);
printf(" ");
}
printf("] \n EP = ");
if(origEP!=NULL) {
print_evalue(stdout, &(origEP->EP), origNames);
}
else {
printf("NULL");
}
printf(" \n Full-dimensional value = ");
value_print(stdout, P_VALUE_FMT, *fullVal);
printf("\n full-dimensional sample = [");
for (j=0; j<sample->NbColumns; j++) {
value_print(stdout, VALUE_FMT, transfSample->p[0][j]);
printf(" ");
}
printf("] \n EP = ");
if(origEP!=NULL) {
print_evalue(stdout, &(origEP->EP), fullNames);
}
else {
printf("NULL");
}
}
if (dbg) {
printf("\nOriginal value = ");
value_print(stdout, VALUE_FMT, *origVal);
printf("\nFull-dimensional value = ");
value_print(stdout, P_VALUE_FMT, *fullVal);
printf("\n");
}
value_clear(*origVal);
value_clear(*fullVal);
}
value_clear(mod);
value_clear(div);
Matrix_Free(sample);
Matrix_Free(smallerSample);
Matrix_Free(transfSample);
Enumeration_Free(origEP);
Enumeration_Free(fullEP);
return isOk;
} /* test_Constraints_fullDimensionize */
