/**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; } }