/**IsEqualOverloaded
* Used to call the overloading function when testing unknown data type for equality
* @param double *d1: pointer on the beginning of the first variable structure
* @param int n1: memory size used by the first variable, only used for overloading
* @param double *d2: pointer on the beginning of the first variable structure
* @param int n2: memory size used by the second variable, only used for overloading
* @return 0 is the variables differ and 1 if they are identical, -1 for recursion purpose
* @author Serge Steer
* @see IsEqualVar
*/
int IsEqualOverloaded(double *d1, int n1, double *d2, int n2)
{
int *id1 = (int *) d1;
int *id2 = (int *) d2;
int il, lw;
int l1, l2;
initStackParameters();
if (Rstk[Pt] == 914 || Rstk[Pt] == 915) /* coming back after evaluation of overloading function */
{
/* Get the computed value */
il = iadr(*Lstk(Top));
Top--;
Pt--;
return *istk(il + 3);
}
/* Prepare stack for calling overloading function */
/* put references to d1 and d2 variable at the top of the stack */
l1 = *Lstk(1) + (int)(d1 - stk(*Lstk(1))); /*compute index in stk from absolute adress value */
l2 = *Lstk(1) + (int)(d2 - stk(*Lstk(1))); /*compute index in stk from absolute adress value */
Top = Top + 1;
il = iadr(*Lstk(Top));
*istk(il) = -id1[0];
*istk(il + 1) = l1; /* index othe first element of the variable in stk */
*istk(il + 2) = 0; /* variable number unknown */
*istk(il + 3) = n1; /* variable memory size */
*Lstk(Top + 1) = *Lstk(Top) + 2;
Top = Top + 1;
il = iadr(*Lstk(Top));
*istk(il) = -id2[0];
*istk(il + 1) = l2; /* index othe first element of the variable in stk */
*istk(il + 2) = 0; /*variable number unknown */
*istk(il + 3) = n2; /*variable memory size */
*Lstk(Top + 1) = *Lstk(Top) + 2;
Ptover(1);
Rhs = 2;
lw = Top - 1;
if ( GetDoubleCompMode() == 0)
{
C2F(overload)(&lw, "isequalbitwise", 14L);
Rstk[Pt] = 914;
}
else
{
C2F(overload)(&lw, "isequal", 7L);
Rstk[Pt] = 915;
}
/*DEBUG_OVERLOADING("IsEqualVar Overloaded calls the parser Top=%d, Rhs=%d, Pt=%d\n",Top,Rhs,Pt);*/
return -1;
}
int C2F(intisequalvar)(char * fname, int *job, long int fl)
{
int topk, top1, srhs, k,kmin, l;
int res = 42; /* Bruno : @TODO initialisation !!! */
int one = 1;
int l1,lk, il1,ilk;
int n1,nk; //memory size used by the variable, only used for overloaded comparison
initStackParameters();
/*DEBUG_OVERLOADING("entering intisequal Top=%d, Rhs=%d, Rstk[pt]=%d\n",Top,Rhs,Rstk[Pt]);*/
SetDoubleCompMode(*job); /* floating point numbers are compared bitwize */
if (Rstk[Pt]==914||Rstk[Pt]==915) { /* coming back after evaluation of overloading function */
/*DEBUG_OVERLOADING("intisequal called back by the parser Top=%d, Rhs=%d, Pt=%d\n",Top,Rhs,Pt);*/
/* Restore context */
kmin = Ids[1 + Pt * nsiz];
srhs = Ids[2 + Pt * nsiz];
topk = Ids[3 + Pt * nsiz];
top1 = Top-1-srhs+1;/* Top-1 because Top has been increased to store the result of overloading function */
}
else {
CheckRhs(2,2000000);
CheckLhs(1,1);
srhs = Rhs;
top1 = Top-srhs+1;
topk = top1 + 1;
kmin = 2;
MaxRec = 0;
Rrec = NULL;
}
l1 = *Lstk(top1);il1 = iadr(l1);
n1 = *Lstk(top1+1)-l1;
if (*istk(il1) < 0) {
l1 = *istk(il1+1);
n1 = *istk(il1+3);
}
for (k = kmin; k <= srhs; k++) {
lk = *Lstk(topk);ilk=iadr(lk);
nk = *Lstk(topk+1)-lk;
if (*istk(ilk) < 0) {
lk= *istk(ilk+1);
nk = *istk(ilk+3);
}
res = IsEqualVar(stk(l1),n1,stk(lk),nk);
if (res==-1) { /* overloading function evaluation required */
/* save context */
Ids[1 + Pt * nsiz] = k;
Ids[2 + Pt * nsiz] = srhs;
Ids[3 + Pt * nsiz] = topk;
return 0;
}
else if (res == -2) {/* Memory allocation failed */
SciError(112);
FreeRec();
return 0;
}
/*DEBUG_OVERLOADING("k=%d, res=%d\n", k,res);*/
if (res == 0) {
/* goto END; */
Top = top1;
C2F(crebmat)(fname, &top1, &one, &one, &l, (unsigned long)strlen(fname));
*istk(l)=res;
FreeRec();
return 0;
}
topk++;
}
/* END:*/
Top = top1;
C2F(crebmat)(fname, &top1, &one, &one, &l, (unsigned long)strlen(fname));
*istk(l)=res;
FreeRec();
return 0;
}
/**IsEqualList
* Used to test a couple of Scilab variable of type list, tlist or mlist for equality
* @param double *d1: pointer on the beginning of the first variable structure
* @param double *d2: pointer on the beginning of the first variable structure
* @return 0 is the variables differ and 1 if they are identical, -1 for recursion purpose, -2 for allocatopn problem
* @author Serge Steer
* @see IsEqualVar
*/
int IsEqualList(double *d1, double *d2)
{
/* This code does not use simple recursion, because of possible need of
* call to Scilab for evaluation of overloading function
* The redusion is emulated using the Rrec data structure to memorize the path
* to the current element.
*/
int l,k,res,nelt;
int *id1, *id2;
int *ip1, *ip2;
double *p1, *p2;
int krec;
initStackParameters();
if (Rstk[Pt]==914||Rstk[Pt]==915) { /* coming back after evaluation of overloading function */
/* Restore context */
krec = Pstk[Pt];
MaxRec = Ids[4 + Pt * nsiz] ;
memcpy(&Rrec,&(Ids[5 + Pt * nsiz]),sizeof(RecursionRecordPtr)); /* recover Rrec pointer */
k = Rrec[krec].k;
d1 = Rrec[krec].d1; /* pointer on the sub-level list 1*/
d2 = Rrec[krec].d2; /* pointer on the sub-level list 2*/
id1 = (int *) d1;
id2 = (int *) d2;
nelt = id1[1];
goto SETLEVEL;
}
else { /* regular entry */
krec = 0;
}
STARTLEVEL:
/* the objects pointed to by d1 and d2 are lists */
/* set current level context */
if (AllocRecIfRequired(krec)==-2) return -2;
Rrec[krec].d1 = d1;
Rrec[krec].d2 = d2;
Rrec[krec].k = 0;
/* check the type */
id1 = (int *) d1;
id2 = (int *) d2;
if ((id1[0] != id2[0])) return 0;
/* check the number of elements */
if (id1[1] != id2[1]) return 0;
nelt = id1[1];
/* check the array of "pointers" on list elements*/
if (!IsEqualIntegerArray(nelt+1, id1+2, id2+2)) return 0;
/*DEBUG_LIST("STARTLEVEL nelt=%d\n",nelt);*/
k = 0;
SETLEVEL:
/* check the list elements */
ip1=id1+2;
ip2=id2+2;
l = (nelt + 4)/2; /* the beginning of first field in the double array */
p1=d1+l;
p2=d2+l;
ELEMENT:
if (k >= nelt) { /* no more element to compare */
if (krec > 0 ) { /* end of a sub-level */
/* restore upper level context*/
krec--;
/*DEBUG_LIST("Sublist ELEMENT index=%d finished, previous restored from krec=%d\n",k+1,krec);*/
d1 = Rrec[krec].d1;
d2 = Rrec[krec].d2;
k = Rrec[krec].k+1;
/* rebuild pointers */
id1 = (int *) d1;
id2 = (int *) d2;
nelt = id1[1];
/*DEBUG_LIST("back to lower level nelt=%d index=%d krec=%d\n",nelt,k+1,krec);*/
goto SETLEVEL;
}
else /* end of main level */
return 1;
}
/* compare next element */
if (ip1[k]==ip1[k+1]) {/* undefined element nothing to check */
k++;
goto ELEMENT;
}
d1 = p1+ip1[k]-1;
d2 = p2+ip2[k]-1;
id1=(int *)d1;
id2=(int *)d2;
if (id1[0]!=15 && id1[0]!=16&& id1[0]!=17) { /* elements which are not lists */
res = IsEqualVar(d1, ip1[k+1]-ip1[k], d2, ip2[k+1]-ip2[k]);
/*DEBUG_LIST("Regular ELEMENT index=%d res=%d\n",k+1,res);*/
if (!res) return 0;
if (res == -1) { /*overloading function evaluation required */
/* preserve context */
Pstk[Pt] = krec;
Ids[4 + Pt * nsiz] = MaxRec;
/* Store Rrec pointer into Ids[5 + Pt * nsiz] and Ids[6 + Pt * nsiz] */
memcpy(&(Ids[5 + Pt * nsiz]),&Rrec,sizeof(RecursionRecordPtr));
return -1;
}
k++;
goto ELEMENT;
}
else { /* sub list found*/
/*DEBUG_LIST("Sublist ELEMENT index=%d started, previous stored in krec=%d\n",k+1,krec);*/
Rrec[krec].k = k;
krec++;
goto STARTLEVEL;
}
}
