Word HAC_CONS(Word c, Word P)
{
Word r,P_r,n,i,M,L,k,m,T,p,cp,I;
Step1: /* Construct empty multiplicity vector. */
r = LELTI(c,LEVEL);
P_r = LELTI(P,r);
n = LENGTH(P_r);
for(i = 0, M = NIL; i < n; i++)
M = COMP(0,M);
Step2: /* Set non-zero entries from cells multiplicity list. */
for(L = LELTI(c,MULSUB); L != NIL; L = RED(L)) {
FIRST2(FIRST(L),&k,&m);
/*-- Find p, the p.f. with index k. --*/
for(T = P_r, i = 1; T != NIL; T = RED(T),i++) {
p = FIRST(T);
if (k == THIRD(LELTI(p,PO_LABEL)))
break; }
/*-- Proj.fac. with index k has been removed from the set. --*/
if (T == NIL) continue;
SLELTI(M,i,m); }
Return: /* Construct cp and return. */
I = LELTI(c,INDX);
cp = LIST2(I,M);
return cp;
}
Word PCADCSV(Word cs, Word Ps)
{
Word c,l,S,s,I,V,Vs;
Step1: /* */
c = LELTI(cs,SC_REP);
l = LELTI(c,LEVEL);
if (l == 0) {
Vs = NIL; goto Return; }
S = LELTI(Ps,l);
for(I = NIL; S != NIL; S = RED(S)) {
s = FIRST(S);
I = COMP(THIRD(LELTI(s,PO_LABEL)),I); }
LBIBMS(I);
I = CINV(I);
V = FIRST(LELTI(c,SIGNPF));
for(Vs = NIL;I != NIL; I = RED(I))
Vs = COMP(LELTI(V,FIRST(I)),Vs);
Return: /* Prepare to return. */
return (Vs);
}
Word CADFPCAD(Word D, Word P, Word S, Word I, Word Pb)
{
Word Db,Is,N,Sb,Pb_N,Ts,L,p,i,is,Q,Ms,C,Cs,Ds,Ss;
Word Mb,mb;
Step1: /* Is D the root cell? */
Db = LELTI(D,SC_REP);
if (LELTI(D,SC_PAR) == NIL) {
Is = NIL;
Ss = NIL;
Ms = NIL; }
else {
Step2: /* D is not the root cell. */
Is = CINV(COMP(LELTI(D,SC_INX),CINV(I)));
N = LENGTH(Is);
Step3: /* Signiture & multiplicity information. */
Sb = FIRST(LELTI(Db,SIGNPF));
Pb_N = LELTI(Pb,N);
Ts = NIL; Ms = NIL; is = 0;
/* Loop over each level N polynomial in P. */
for(L = CINV(LELTI(P,N)); L != NIL; L = RED(L)) {
p = FIRST(L); i = 1; is++;
/* Set i so that p is the ith level N pol in Pb. */
i = PFPIPFL(p,Pb_N);
if (i == 0) { SWRITE("CAPFPCAD: Can't find the polynomial!\n"); }
Ts = COMP(LELTI(Sb,i),Ts);
/* Set the multiplicity list if necessary */
for (Mb = LELTI(Db,MULSUB); Mb != NIL; Mb = RED(Mb)) {
mb = FIRST(Mb);
if (FIRST(mb) == THIRD(LELTI(p,PO_LABEL))) {
Ms = COMP(mb,Ms); } } }
/* Ms = CINV(Ms); */
Ss = COMP(Ts,S); }
Step4: /* Children. */
C = LELTI(D,SC_CDTV);
if ( ISATOM(C) ) {
Cs = NIL; }
else {
for(Cs = NIL; C != NIL; C = RED(C)) {
Cs = COMP(CADFPCAD(FIRST(C),P,Ss,Is,Pb),Cs); }
Cs = CINV(Cs); }
Step5: /* */
Ds = LCOPY(Db);
SLELTI(Ds,CHILD,Cs);
SLELTI(Ds,INDX,Is);
SLELTI(Ds,SIGNPF,Ss);
SLELTI(Ds,HOWTV,NOTDET); /* Might want to change. */
SLELTI(Ds,MULSUB,Ms);
Return: /* Prepare to return. */
return (Ds);
}
std::string convert(const std::string& src){
std::string result;
unsigned long long hash = 0;
for(int i=0;i<3;i++){
hash *= 256;
hash += (unsigned long long)(src[i]);
}
result += table.table[FIRST(hash)];
result += table.table[SECOND(hash)];
result += table.table[THIRD(hash)];
result += table.table[FORTH(hash)];
return std::move(result);
}
Word LPFSETMINUS(Word S, Word G)
{
Word Q,Sp,s,i_s,t,Gp;
Step1: /* Initialize. */
Q = NIL;
Step2: /* Loop over each polynomial s in S. */
for(Sp = CINV(S); Sp != NIL; Sp = RED(Sp)) {
s = FIRST(Sp);
i_s = THIRD(LELTI(s,PO_LABEL));
Step3: /* Test if s is in G. */
t = 0;
for(Gp = G; t == 0 && Gp != NIL; Gp = RED(Gp))
t = (i_s == THIRD(LELTI(FIRST(Gp),PO_LABEL)));
Step4: /* If s is not in G then add s to Q. */
if (! t)
Q = COMP(s,Q); }
Return: /* Return. */
return (Q);
}
Word LDCOEFMASK(Word c, Word P, Word J)
{
Word *A,P_2,n,i,M,P_1,L,m,j,p,Lp,h,q,v,l;
Step1: /* Set up A to be a characteristic vector for the set of
level 2 proj fac's whose leading coefficients vanish in c. */
P_2 = LELTI(P,2);
n = THIRD(LELTI(LAST(P_2),PO_LABEL));
A = GETARRAY(n + 1);
for(i = 1; i <= n; i++)
A[i] = 0;
Step2: /* Set L to be the list of projection factors which vanish in c. */
M = LELTI(c,MULSUB);
P_1 = LELTI(P,1);
L = NIL;
while(M != NIL) {
ADV(M,&m,&M);
j = FIRST(m);
do
ADV(P_1,&p,&P_1);
while(j != THIRD(LELTI(p,PO_LABEL)));
L = COMP(p,L); }
Step3: /* Set Lp to the list of projection polynomials with factors in L. */
Lp = NIL;
while(L != NIL) {
ADV(L,&p,&L);
for(h = LELTI(p,PO_PARENT); h != NIL; h = RED(h))
Lp = COMP(THIRD(FIRST(h)),Lp); }
Step4: /* Run through the histories of each polynomial in Lp. If the
polynomial is the leading coefficient of some bivariate projection factor,
set A at the index for that projection factor to 1. */
while(Lp != NIL) {
ADV(Lp,&p,&Lp);
for(h = LELTI(p,PO_PARENT); h != NIL; h = RED(h)) {
q = FIRST(h);
if (FIRST(q) == PO_LCO) {
l = LELTI(THIRD(q),PO_LABEL);
if (SECOND(l) == 2)
A[ THIRD(l) ] = 1; } } }
Step5: /* Create the vector itself! */
v = NIL;
while(P_2 != NIL) {
ADV(P_2,&p,&P_2);
j = THIRD(LELTI(p,PO_LABEL));
v = COMP(A[j],v); }
v = INV(v);
Return: /* Prepare to return. */
FREEARRAY(A);
return v;
}
void TDTOD(Word P, Word N, Word ***P2_, Word *P1_, Word *k_)
{
Word **P2,Pp,i,pp,n,k,m,j,P1,I,l;
Step1: /* Allocate P2. At the end of the loop k is # of pf's in P. */
P2 = (Word**)GETARRAY((N+1)*(sizeof(Word*)/sizeof(Word))); /* ASSUMES THIS / IS EXACT! */
Pp = P; k = 0;
for(i = 1; i <= N; i++) {
ADV(Pp,&pp,&Pp);
n = LENGTH(pp);
k += n;
/* Finds I, the largest index in pp. */
for(I = 0; pp != NIL; pp = RED(pp))
I = IMAX(THIRD(LELTI(FIRST(pp),PO_LABEL)),I);
P2[i] = (Word*)GETARRAY(I+1);
P2[i][0] = n; }
Step2: /* Construct P1. */
P1 = NIL; m = k - 1;
Pp = NIL;
for(i = N; i > 0; i--) { Pp = COMP(LELTI(P,i),Pp); }
for(Pp = INV(Pp); Pp != NIL; Pp = RED(Pp)) {
for(pp = CINV(FIRST(Pp)); pp != NIL; pp = RED(pp)) {
l = LELTI(FIRST(pp),PO_LABEL);
FIRST2(RED(l),&i,&j);
P2[i][j] = m--;
P1 = COMP(l,P1); } }
Return: /* Prepare to return. */
*P2_ = P2;
*P1_ = P1;
*k_ = k;
return;
}
Word RMCAFS(Word F)
{
Word F1,F2,Fb,Fp,Fp1,Fp2,T,t,t1,t2;
/* hide t,t1,t2; */
Step1: /* Classify the formula F. */
T = FIRST(F);
if (T == ANDOP) goto Step3;
if (T == OROP) goto Step4;
if (T == NOTOP) goto Step5;
if (T == RIGHTOP) goto Step6;
if (T == LEFTOP) goto Step7;
if (T == EQUIOP) goto Step8;
Step2: /* Atomic Formula. */
t = TYPEAF(F);
if (t == TRUE) {
Fp = LIST4(EQOP,0,0,NIL);
goto Return;
}
if (t == FALSE) {
Fp = LIST4(NEOP,0,0,NIL);
goto Return;
}
Fp = F;
goto Return;
Step3: /* Conjunction. */
Fb = RED(F);
Fp = LIST1(ANDOP);
while (Fb != NIL)
{
ADV(Fb,&F1,&Fb);
Fp1 = RMCAFS(F1);
t = TYPEQFF(Fp1);
if (t == FALSE) {
Fp = LIST4(NEOP,0,0,NIL);
goto Return;
}
if (t == UNDET) Fp = COMP(Fp1,Fp);
}
if (LENGTH(Fp) == 1) {
Fp = LIST4(EQOP,0,0,NIL);
goto Return;
}
if (LENGTH(Fp) == 2) {
Fp = FIRST(Fp);
goto Return;
}
Fp = INV(Fp);
goto Return;
Step4: /* Disjunction. */
Fb = RED(F);
Fp = LIST1(OROP);
while (Fb != NIL)
{
ADV(Fb,&F1,&Fb);
Fp1 = RMCAFS(F1);
t = TYPEQFF(Fp1);
if (t == TRUE) {
Fp = LIST4(EQOP,0,0,NIL);
goto Return;
}
if (t == UNDET) Fp = COMP(Fp1,Fp);
}
if (LENGTH(Fp) == 1) {
Fp = LIST4(NEOP,0,0,NIL);
goto Return;
}
if (LENGTH(Fp) == 2) {
Fp = FIRST(Fp);
goto Return;
}
Fp = INV(Fp);
goto Return;
Step5: /* Negation. */
F1 = SECOND(F);
Fp1 = RMCAFS(F1);
t = TYPEQFF(Fp1);
if (t == TRUE) Fp = LIST4(NEOP,0,0,NIL);
else if (t == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else Fp = LIST2(NOTOP,Fp1);
goto Return;
Step6: /* $\Rightarrow$. */
F1 = SECOND(F);
Fp1 = RMCAFS(F1);
t1 = TYPEQFF(Fp1);
F2 = THIRD(F);
Fp2 = RMCAFS(F2);
t2 = TYPEQFF(Fp2);
if (t1 == TRUE) Fp = Fp2;
else if (t1 == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == TRUE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1);
else Fp = LIST3(RIGHTOP,Fp1,Fp2);
goto Return;
Step7: /* $\Leftarrow$. */
F1 = THIRD(F);
Fp1 = RMCAFS(F1);
t1 = TYPEQFF(Fp1);
F2 = SECOND(F);
Fp2 = RMCAFS(F2);
t2 = TYPEQFF(Fp2);
if (t1 == TRUE) Fp = Fp2;
else if (t1 == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == TRUE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1);
else Fp = LIST3(LEFTOP,Fp2,Fp1);
goto Return;
Step8: /* $\Leftrightarrow$. */
F1 = SECOND(F);
Fp1 = RMCAFS(F1);
t1 = TYPEQFF(Fp1);
F2 = THIRD(F);
Fp2 = RMCAFS(F2);
t2 = TYPEQFF(Fp2);
if (t1 == TRUE) Fp = Fp2;
else if (t2 == TRUE) Fp = Fp1;
else if (t1 == FALSE && t2 == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else if (t1 == FALSE) Fp = LIST2(NOTOP,Fp2);
else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1);
else Fp = LIST3(EQUIOP,Fp1,Fp2);
goto Return;
Return: /* Prepare for return. */
return(Fp);
}
Word ISDESIRED(Word c, Word C)
{
Word C1,C2,Cp,T,V1,V2,t;
/* hide C1,C2,Cp,T,V1,V2,t; */
Step1: /* Classify the condition. */
if (LELTI(c,LEVEL) == 0) { t = 1; goto Return; }
T = FIRST(C);
if (T == OROP) goto Step3;
if (T == ANDOP) goto Step4;
if (T == NOTOP) goto Step5;
if (T == LEFTOP) goto Step6;
if (T == RIGHTOP) goto Step7;
if (T == EQUIOP) goto Step8;
Step2: /* Atomic condition. */
V1 = SECOND(C); V2 = THIRD(C);
if (V1 < 0 ) V1 = CELLATTR(c,V1);
if (V2 < 0 ) V2 = CELLATTR(c,V2);
if (V1 == NIL || V2 == NIL)
{t = 0; goto Return;}
switch(T)
{
case LTOP: t = (V1 < V2 ? 1 : 0); break;
case EQOP: t = (V1 == V2 ? 1 : 0); break;
case GTOP: t = (V1 > V2 ? 1 : 0); break;
case GEOP: t = (V1 >= V2 ? 1 : 0); break;
case NEOP: t = (V1 != V2 ? 1 : 0); break;
case LEOP: t = (V1 <= V2 ? 1 : 0); break;
}
goto Return;
Step3: /* Disjunction. */
Cp = RED(C);
while (Cp != NIL)
{
ADV(Cp,&C1,&Cp);
t = ISDESIRED(c,C1);
if (t == 1) goto Return;
}
t = 0;
goto Return;
Step4: /* Conjunction. */
Cp = RED(C);
while (Cp != NIL)
{
ADV(Cp,&C1,&Cp);
t = ISDESIRED(c,C1);
if (t == 0) goto Return;
}
t = 1;
goto Return;
Step5: /* Negation. */
C1 = SECOND(C);
t = (ISDESIRED(c,C1) ? 0 : 1);
goto Return;
Step6: /* <==. */
C1 = SECOND(C);
C2 = THIRD(C);
t = (ISDESIRED(c,C1) || (!ISDESIRED(c,C2)) ? 1 : 0);
goto Return;
Step7: /* ==>. */
C1 = SECOND(C);
C2 = THIRD(C);
t = ((!ISDESIRED(c,C1)) || ISDESIRED(c,C2) ? 1 : 0);
goto Return;
Step8: /* <==>. */
C1 = SECOND(C);
C2 = THIRD(C);
t = (ISDESIRED(c,C1) == ISDESIRED(c,C2) ? 1 : 0);
goto Return;
Return: /* Prepare for return. */
return(t);
}
/*
* Evaluate a function object into a object.
*/
COObject *
vm_eval(COObject *func, COObject *globals)
{
#define JUMPBY(offset) next_code += offset
#define JUMPTO(offset) next_code = first_code + offset
#define NEXTOP() (*next_code++)
#define NEXTARG() (next_code += 2, (next_code[-1]<<8) + next_code[-2])
#define GETITEM(v, i) COTuple_GET_ITEM((COTupleObject *)(v), i)
#define GETLOCAL(i) (fastlocals[i])
#define SETLOCAL(i, v) \
do { \
COObject *tmp = GETLOCAL(i); \
GETLOCAL(i) = v; \
CO_XDECREF(tmp); \
} while (0);
#define PUSH(o) (*stack_top++ = (o))
#define POP() (*--stack_top)
#define TOP() (stack_top[-1])
#define SET_TOP(o) (stack_top[-1] = (o))
#define SECOND() (stack_top[-2])
#define THIRD() (stack_top[-3])
#define FOURTH() (stack_top[-4])
#define PEEK(n) (stack_top[-(n)])
#define STACK_ADJ(n) (stack_top += n)
#define STACK_LEVEL() ((int)(stack_top - TS(frame)->f_stack))
#define UNWIND_BLOCK(b) \
do { \
while (STACK_LEVEL() > (b)->fb_level) { \
COObject *o = POP(); \
CO_XDECREF(o); \
} \
} while (0)
COCodeObject *code;
COObject *names;
COObject *consts;
COObject *localnames;
COObject *funcargs = COList_New(0);
COObject **fastlocals;
COObject **stack_top; /* Stack top, points to next free slot in stack */
unsigned char *next_code;
unsigned char *first_code;
unsigned char opcode; /* Current opcode */
int oparg; /* Current opcode argument, if any */
COObject *x; /* Result object -- NULL if error */
COObject *o1, *o2, *o3; /* Temporary objects popped of stack */
int status; /* VM status */
int err; /* C function error code */
status = STATUS_NONE;
TS(frame) =
(COFrameObject *)COFrame_New((COObject *)TS(frame), func, globals);
new_frame: /* reentry point when function call/return */
code = (COCodeObject *)((COFunctionObject *)TS(frame)->f_func)->func_code;
stack_top = TS(frame)->f_stacktop;
names = code->co_names;
localnames = code->co_localnames;
consts = code->co_consts;
first_code = (unsigned char *)COBytes_AsString(code->co_code);
next_code = first_code + TS(frame)->f_lasti;
fastlocals = TS(frame)->f_extraplus;
/* Parse arguments. */
if (COList_GET_SIZE(funcargs)) {
// check arguments count
if (code->co_argcount != COList_GET_SIZE(funcargs)) {
COErr_Format(COException_ValueError,
"takes exactly %d arguments (%d given)",
code->co_argcount, COList_Size(funcargs));
status = STATUS_EXCEPTION;
goto fast_end;
}
size_t n = COList_Size(funcargs);
for (int i = 0; i < n; i++) {
x = COList_GetItem(funcargs, 0);
CO_INCREF(x);
SETLOCAL(n - i - 1, x);
COList_DelItem(funcargs, 0);
}
}
for (;;) {
opcode = NEXTOP();
switch (opcode) {
case OP_BINARY_ADD:
o1 = POP();
o2 = TOP();
if (COStr_Check(o1) && COStr_Check(o2)) {
COStr_Concat(&o2, o1);
x = o2;
goto skip_decref_o2;
} else {
x = COInt_Type.tp_int_interface->int_add(o1, o2);
}
CO_DECREF(o2);
skip_decref_o2:
CO_DECREF(o1);
SET_TOP(x);
if (!x) {
status = STATUS_EXCEPTION;
goto fast_end;
}
break;
case OP_BINARY_SUB:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_sub(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_MUL:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_mul(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_DIV:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_div(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_MOD:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_mod(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_SL:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_lshift(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_SR:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_rshift(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_SUBSCRIPT:
o1 = POP();
o2 = TOP();
if (!CO_TYPE(o2)->tp_mapping_interface) {
COErr_Format(COException_TypeError,
"'%.200s' object is not subscriptable",
CO_TYPE(o2)->tp_name);
status = STATUS_EXCEPTION;
} else {
x = CO_TYPE(o2)->tp_mapping_interface->mp_subscript(o2, o1);
if (!x) {
status = STATUS_EXCEPTION;
goto fast_end;
}
}
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_CMP:
o1 = POP();
o2 = TOP();
oparg = NEXTARG();
x = vm_cmp(oparg, o1, o2);
if (!x) {
status = STATUS_EXCEPTION;
goto fast_end;
}
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_UNARY_NEGATE:
o1 = TOP();
x = COInt_Type.tp_int_interface->int_neg(o1);
CO_DECREF(o1);
SET_TOP(x);
break;
case OP_UNARY_INVERT:
o1 = TOP();
x = COInt_Type.tp_int_interface->int_invert(o1);
CO_DECREF(o1);
SET_TOP(x);
break;
case OP_LOAD_LOCAL:
oparg = NEXTARG();
x = GETLOCAL(oparg);
CO_INCREF(x);
PUSH(x);
break;
case OP_LOAD_NAME:
oparg = NEXTARG();
o1 = GETITEM(names, oparg);
x = COObject_get(o1);
if (!x) {
COErr_Format(COException_NameError, "name '%s' is not defined",
COStr_AsString(o1));
status = STATUS_EXCEPTION;
goto fast_end;
}
CO_INCREF(x);
PUSH(x);
break;
case OP_LOAD_UPVAL:
oparg = NEXTARG();
o1 = COTuple_GET_ITEM(((COFunctionObject *)func)->func_upvalues,
oparg);
o2 = COCell_Get(o1);
PUSH(o2);
break;
case OP_LOAD_CONST:
oparg = NEXTARG();
x = GETITEM(consts, oparg);
CO_INCREF(x);
PUSH(x);
break;
case OP_BUILD_TUPLE:
oparg = NEXTARG();
x = COTuple_New(oparg);
if (x != NULL) {
for (; --oparg >= 0;) {
o1 = POP();
COTuple_SetItem(x, oparg, o1);
CO_DECREF(o1);
}
PUSH(x);
}
break;
case OP_BUILD_LIST:
oparg = NEXTARG();
x = COList_New(oparg);
if (x != NULL) {
for (; --oparg >= 0;) {
o1 = POP();
COList_SetItem(x, oparg, o1);
CO_DECREF(o1);
}
PUSH(x);
}
break;
case OP_DICT_BUILD:
oparg = NEXTARG();
x = CODict_New();
PUSH(x);
break;
case OP_DICT_ADD:
o1 = POP();
o2 = POP();
o3 = POP();
CODict_SetItem(o3, o2, o1);
x = o3;
CO_DECREF(o1);
CO_DECREF(o2);
PUSH(x);
break;
case OP_STORE_NAME:
oparg = NEXTARG();
o1 = GETITEM(names, oparg);
o2 = POP();
COObject_set(o1, o2);
CO_DECREF(o2);
break;
case OP_STORE_UPVAL:
oparg = NEXTARG();
o1 = COTuple_GET_ITEM(((COFunctionObject *)func)->func_upvalues,
oparg);
o2 = POP();
COCell_Set(o1, o2);
CO_DECREF(o2);
break;
case OP_STORE_LOCAL:
oparg = NEXTARG();
o1 = POP();
SETLOCAL(oparg, o1);
break;
case OP_JMPZ:
oparg = NEXTARG();
o1 = POP();
if (o1 == CO_True) {
} else if (o1 == CO_False) {
JUMPTO(oparg);
} else {
err = COObject_IsTrue(o1);
if (err > 0)
err = 0;
else if (err == 0)
JUMPTO(oparg);
}
CO_DECREF(o1);
break;
case OP_JMP:
oparg = NEXTARG();
JUMPBY(oparg);
break;
case OP_JMPX:
oparg = NEXTARG();
JUMPTO(oparg);
break;
case OP_DECLARE_FUNCTION:
o1 = POP();
x = COFunction_New(o1);
COCodeObject *c = (COCodeObject *)o1;
for (int i = 0; i < CO_SIZE(c->co_upvals); i++) {
COObject *name = COTuple_GET_ITEM(c->co_upvals, i);
COObject *upvalue = COObject_get(name);
if (!upvalue) {
// local variables
for (int j = 0; j < COTuple_Size(localnames); j++) {
if (COObject_CompareBool
(COTuple_GET_ITEM(localnames, j), name, Cmp_EQ)) {
upvalue = GETLOCAL(j);
}
}
}
COObject *cell = COCell_New(upvalue);
COTuple_SET_ITEM(((COFunctionObject *)x)->func_upvalues, i,
cell);
}
CO_DECREF(o1);
PUSH(x);
break;
case OP_CALL_FUNCTION:
o1 = POP();
oparg = NEXTARG();
COObject *args = COTuple_New(oparg);
while (--oparg >= 0) {
o2 = POP();
COTuple_SetItem(args, oparg, o2);
CO_DECREF(o2);
}
if (COCFunction_Check(o1)) {
COCFunction cfunc = COCFunction_GET_FUNCTION(o1);
x = cfunc(NULL, args);
CO_DECREF(o1);
CO_DECREF(args);
PUSH(x);
} else if (COFunction_Check(o1)) {
ssize_t i = CO_SIZE(args);
while (--i >= 0) {
COList_Append(funcargs, COTuple_GET_ITEM(args, i));
}
CO_DECREF(args);
TS(frame)->f_stacktop = stack_top;
TS(frame)->f_lasti = (int)(next_code - first_code);
TS(frame) =
(COFrameObject *)COFrame_New((COObject *)TS(frame), o1,
globals);
CO_DECREF(o1);
func = o1;
goto new_frame;
} else {
x = COObject_Call(o1, args);
CO_DECREF(args);
CO_DECREF(o1);
PUSH(x);
}
break;
case OP_RETURN:
o1 = POP();
TS(frame)->f_stacktop = stack_top;
TS(frame)->f_lasti = (int)(next_code - first_code);
COFrameObject *old_frame = (COFrameObject *)TS(frame);
TS(frame) = (COFrameObject *)old_frame->f_prev;
CO_DECREF(old_frame);
if (!TS(frame)) {
CO_DECREF(o1);
goto vm_exit;
}
// init function return
*(TS(frame)->f_stacktop++) = o1;
goto new_frame;
break;
case OP_SETUP_LOOP:
oparg = NEXTARG();
COFrameBlock_Setup(TS(frame), opcode, oparg, STACK_LEVEL());
break;
case OP_SETUP_TRY:
oparg = NEXTARG();
COFrameBlock_Setup(TS(frame), opcode, oparg, STACK_LEVEL());
break;
case OP_POP_BLOCK:
{
COFrameBlock *fb = COFrameBlock_Pop(TS(frame));
UNWIND_BLOCK(fb);
}
break;
case OP_POP_TRY:
{
COFrameBlock *fb = COFrameBlock_Pop(TS(frame));
UNWIND_BLOCK(fb);
}
break;
case OP_BREAK_LOOP:
status = STATUS_BREAK;
break;
case OP_CONTINUE_LOOP:
oparg = NEXTARG();
status = STATUS_CONTINUE;
break;
case OP_THROW:
oparg = NEXTARG();
if (oparg == 1) {
o1 = POP();
} else if (oparg == 0) {
o1 = CO_None;
} else {
error("error oparg");
}
status = STATUS_EXCEPTION;
COErr_SetObject(COException_SystemError, o1);
break;
case OP_DUP_TOP:
o1 = TOP();
CO_INCREF(o1);
PUSH(o1);
break;
case OP_POP_TOP:
o1 = POP();
CO_DECREF(o1);
break;
case OP_END_TRY:
o1 = POP();
COErr_SetString(COException_SystemError, COStr_AsString(o1));
status = STATUS_EXCEPTION;
CO_DECREF(o1);
break;
case OP_SETUP_FINALLY:
oparg = NEXTARG();
COFrameBlock_Setup(TS(frame), opcode, oparg, STACK_LEVEL());
break;
case OP_END_FINALLY:
o1 = POP();
if (o1 != CO_None) {
COErr_SetString(COException_SystemError, COStr_AsString(o1));
status = STATUS_EXCEPTION;
}
CO_DECREF(o1);
break;
case OP_STORE_SUBSCRIPT:
o1 = TOP();
o2 = SECOND();
o3 = THIRD();
STACK_ADJ(-3);
if (COList_Check(o3)) {
err = COList_SetItem(o3, COInt_AsSsize_t(o2), o1);
} else if (CODict_Check(o3)) {
CODict_SetItem(o3, o2, o1);
} else {
error("wrong store subscript");
}
CO_DECREF(o1);
CO_DECREF(o2);
CO_DECREF(o3);
break;
case OP_GET_ITER:
o1 = TOP();
x = COObject_GetIter(o1);
CO_DECREF(o1);
SET_TOP(x);
break;
case OP_FOR_ITER:
oparg = NEXTARG();
o1 = TOP();
x = (*o1->co_type->tp_iternext) (o1);
if (x) {
PUSH(x);
break;
}
o1 = POP();
CO_DECREF(o1);
JUMPTO(oparg);
break;
default:
error("unknown handle for opcode(%ld)\n", opcode);
}
fast_end:
while (status != STATUS_NONE && TS(frame)->f_iblock > 0) {
COFrameBlock *fb =
&TS(frame)->f_blockstack[TS(frame)->f_iblock - 1];
if (fb->fb_type == OP_SETUP_LOOP && status == STATUS_CONTINUE) {
status = STATUS_NONE;
JUMPTO(oparg);
break;
}
TS(frame)->f_iblock--;
UNWIND_BLOCK(fb);
if (fb->fb_type == OP_SETUP_LOOP && status == STATUS_BREAK) {
status = STATUS_NONE;
JUMPTO(fb->fb_handler);
break;
}
if (fb->fb_type == OP_SETUP_TRY && status == STATUS_EXCEPTION) {
status = STATUS_NONE;
COObject *exc, *val, *tb;
COErr_Fetch(&exc, &val, &tb);
PUSH(val);
JUMPTO(fb->fb_handler);
break;
}
}
/* End the loop if we still have an error (or return) */
x = NULL;
if (status != STATUS_NONE)
break;
}
vm_exit:
/* Clear frame stack. */
while (TS(frame)) {
COFrameObject *tmp_frame = (COFrameObject *)TS(frame)->f_prev;
CO_DECREF(TS(frame));
TS(frame) = tmp_frame;
}
return x;
}
void SPFRPSFT(Word P, Word c, Word k, Word *R_, Word *F_)
{
Word R,F,Pk1,l,R1,i,j,S,Si,Pi,Sij,Pij,G,g;
Word H,h,f1,f2,f3,f4,f5,f6,n,n1,n2,L,L1,L2;
Step1: /* Initialize. */
Pk1 = LELTI(P,k+1);
l = LENGTH(Pk1);
R = NIL;
for (i=1; i<=l; i++) {
R1 = NIL;
for (j=1; j<=l; j++)
R1 = COMP(1,R1);
R = COMP(R1,R); }
F = NIL;
for (i=1; i<=l; i++)
F = COMP(1,F);
if (l == 0) goto Return;
Step2: /* Update. */
S = LELTI(c,SIGNPF);
S = CINV(S);
for (i=1; i<=k; i++) {
ADV(S,&Si,&S);
ADV(P,&Pi,&P);
while (Si != NIL) {
ADV(Si,&Sij,&Si);
ADV(Pi,&Pij,&Pi);
if (Sij != 0) continue;
G = LELTI(Pij,PO_PARENT);
while (G != NIL) {
ADV(G,&g,&G);
if (FIRST(g) != PO_FAC) continue;
H = LELTI(THIRD(g),PO_PARENT);
while (H != NIL) {
ADV(H,&h,&H);
switch(FIRST(h)) {
case PO_LCO:
FIRST3(h,&f1,&f2,&f3);
if (f2 != 0) break;
L = LELTI(f3,PO_LABEL);
if (SECOND(L) != k+1) break;
n = PLPOS(Pk1,THIRD(L));
if (n == 0) FAIL("SPFRPSFT","PO_LCO");
SLELTI(F,n,0);
break;
case PO_DIS:
FIRST4(h,&f1,&f2,&f3,&f4);
if (f2 != 0 || f3 != 0) break;
L = LELTI(f4,PO_LABEL);
if (SECOND(L) != k+1) break;
n = PLPOS(Pk1,THIRD(L));
if (n == 0) FAIL("SPFRPSFT","PO_DIS");
SLELTI(F,n,0);
break;
case PO_RES:
FIRST6(h,&f1,&f2,&f3,&f4,&f5,&f6);
if (f2 != 0 || f3 != 0 || f5 != 0) break;
L1 = LELTI(f4,PO_LABEL);
if (SECOND(L1) != k+1) break;
L2 = LELTI(f6,PO_LABEL);
if (SECOND(L2) != k+1)
FAIL("SPFRPSFT","resultant of diff level");
n1 = PLPOS(Pk1,THIRD(L1));
if (n1 == 0) FAIL("SPFRPSFT","PO_RES: n1");
n2 = PLPOS(Pk1,THIRD(L2));
if (n2 == 0) FAIL("SPFRPSFT","PO_RES: n2");
if (n2 > n1)
SLELTI(LELTI(R,n1),n2,0);
else
FAIL("SPFRPSFT","n2 <= n1");
break; } } } } }
Return: /* Prepare for return. */
*R_ = R;
*F_ = F;
return;
}
void EC1(Word c, Word L, Word Bs)
{
Word B,I,J,Lp,M,N,S,Sp,P,a,b,kp,l,r,rp,s,xb,xp,Lp1,OL;
/* hide kp,xp; */
Word T;
Step1: /* Initialize. */
S = NIL; Lp = L; kp = 1; xp = 0;
M = PMON(1,1); J = LIST2(0,0);
Step2: /* No real root. */
if (Lp != NIL) goto Step3;
a = CSSP(NIL,NIL);
b = LIST1(a); s = LIST3(M,J,b);
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S);
SLELTI(c,CHILD,S);
goto Return;
Step3: /* First sector. */
ADV(Lp,&Lp1,&Lp);
FIRST3(Lp1,&B,&I,&OL); FIRST2(I,&l,&r);
a = AFFRN(CSSP(NIL,l));
T = r;
b = LIST1(a); s = LIST3(M,J,b);
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S);
Step4: /* First section. */
if (PDEG(B) == 1)
{ a = IUPRLP(B); a = AFFRN(a); b = LIST1(a); s = LIST3(M,J,b); }
else
{ a = AFGEN(); b = LIST1(a); s = LIST3(B,I,b); }
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
N = NIL;
for(Word X = OL; X != NIL; X = RED(X)) { N = COMP(LIST2(THIRD(LELTI(FIRST(X),PO_LABEL)),1),N); }
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,N); S = COMP(Sp,S);
Step5: /* Check if there are more roots. */
if (Lp == NIL) goto Step9;
rp = r;
Step6: /* Next sector. */
ADV(Lp,&Lp1,&Lp);
FIRST3(Lp1,&B,&I,&OL); FIRST2(I,&l,&r);
a = AFFRN(CSSP(T,l));
T = r;
b = LIST1(a); s = LIST3(M,J,b);
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S);
Step7: /* Next section. */
if (PDEG(B) == 1)
{ a = IUPRLP(B); a = AFFRN(a); b = LIST1(a); s = LIST3(M,J,b); }
else
{ a = AFGEN(); b = LIST1(a); s = LIST3(B,I,b); }
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
N = NIL;
for(Word X = OL; X != NIL; X = RED(X)) { N = COMP(LIST2(THIRD(LELTI(FIRST(X),PO_LABEL)),1),N); }
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,N); S = COMP(Sp,S);
Step8: /* Loop. */
goto Step5;
Step9: /* Last sector. */
a = AFFRN(CSSP(T,NIL));
b = LIST1(a); s = LIST3(M,J,b);
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S);
Step10: /* Finalize. */
S = INV(S); SLELTI(c,CHILD,S); goto Return;
Return: /* Prepare for return. */
return;
}
