static B jtspsscell(J jt,A w,I wf,I wcr,A*zc,A*zt){A c,t,y;B b;
I cn,*cv,j,k,m,n,p,*s,tn,*tv,*u,*u0,*v,*v0;P*wp;
wp=PAV(w); s=AS(w); p=3+s[wf];
y=SPA(wp,i); s=AS(y); m=s[0]; n=s[1];
u0=AV(y); u=u0+n;
v0=u0+wf; v=v0+n;
if(!m){*zt=*zc=mtv; R 1;}
GATV(t,INT,2+2*m,1,0); tv=AV(t); tv[0]=tv[1]=0; tn=2;
GATV(c,INT, 2*m,2,0); cv=AV(c); cv[0]=0; cn=0; *(1+AS(c))=2;
for(j=1;j<m;++j){
b=1;
for(k=0;k<wf;++k)
if(u0[k]!=u[k]){
tv[tn++]=j; tv[tn++]=j; cv[1+cn]=tn-cv[cn];
if(p==tn-cv[cn]){++cv[cn]; cv[1+cn]-=2;}
cn+=2;
cv[cn]=tn-2; u0=u; v0=v; b=0;
break;
}
if(b&&*v0!=*v){tv[tn++]=j; v0=v;}
u+=n; v+=n;
}
tv[tn++]=m; tv[tn++]=m; cv[1+cn]=tn-cv[cn];
if(p==tn-cv[cn]){++cv[cn]; cv[1+cn]-=2;}
cn+=2;
AN(t)= *AS(t)=tn; *zt=t; /* cell divisions (row indices in y) */
AN(c)=cn; *AS(c)=cn/2; *zc=c; /* item divisions (indices in t, # of elements) */
R 1;
} /* frame: all sparse; cell: 1 or more sparse, then dense */
static F2(jtpdtspmv){A ax,b,g,x,wx,y,yi,yj,z;B*bv;I m,n,s[2],*u,*v,*yv;P*ap,*wp,*zp;
RZ(a&&w);
ap=PAV(a); y=SPA(ap,i); yv=AV(y); s[0]=n=*AS(y); s[1]=1;
GATV(yj,INT,n,2,s);
if(DENSE&AT(w)){
GATV(yi,INT,n,2,s); u=AV(yi); AR(yj)=1; v=AV(yj);
DO(n, *u++=*yv++; *v++=*yv++;);
static DF1(jtgsuffix){A h,*hv,z,*zv;I m,n,r;
RZ(w);
if(jt->rank&&jt->rank[1]<AR(w)){r=jt->rank[1]; jt->rank=0; R rank1ex(w,self,jt->rank[1],jtgsuffix);}
jt->rank=0;
n=IC(w);
h=VAV(self)->h; hv=AAV(h); m=AN(h);
GATV(z,BOX,n,1,0); zv=AAV(z);
DO(n, RZ(zv[i]=df1(drop(sc(i),w),hv[i%m])););
static F2(jtcfrz){A z;B b=0,p;I j,n;Z c,d,*t,*u,*v;
RZ(w=rsort(w));
n=AN(w); u=ZAV(w);
GATV(z,CMPX,1+n,1,0); v=ZAV(z); *v=c=*ZAV(a); p=!c.im;
for(j=0;j<n;++j){
d=znegate(u[j]); t=j+v; *(1+t)=*t;
DO(j, *t=zplus(*(t-1),ztymes(d,*t)); --t;);
*v=ztymes(d,*v);
if(p&&d.im)if(b=!b)c=u[j]; else if(p=ZCJ(c,u[j])){t=v; DO(2+j, t++->im=0.0;);}
static A jtmakename(J jt,C*s){A z;I m;NM*zv;
m=strlen(s);
GATV(z,NAME,m,1,0); zv=NAV(z); // Use GATV because GA doesn't support NAME type
MC(zv->s,s,m); *(m+zv->s)=0;
zv->m =(UC)m;
zv->bucket=zv->bucketx=0;
zv->flag=NMDOT;
zv->hash=nmhash(m,s);
ACX(z);
R z;
}
static A jtcongotoblk(J jt,I n,CW*con){A z;CW*d=con;I i,j,k,*u,*v;
GATV(z,INT,2*n,2,0); v=AS(z); v[0]=n; v[1]=2;
u=v=AV(z);
for(i=j=0;i<n;++i,++d){
*u++=-1; *u++=-1;
switch(d->type){
case CEND:
v[k]=i; while(0<k&&0<v[k])k-=2; break;
case CCASE: case CCATCH: case CDO: case CELSE: case CELSEIF: case CFCASE:
v[k]=i; /* fall thru */
case CFOR: case CIF: case CSELECT: case CTRY: case CWHILE: case CWHILST:
v[j]=i; k=1+j; j+=2;
}}
R z;
} /* compute blocks for goto checking */
static A jtgrd1spz(J jt,A w,I wf,I wcr){A z;I*ws,zn;
ws=AS(w);
RE(zn=prod(wf+!!wcr,ws));
GATV(z,INT,zn,1+wf,ws); if(!wcr)*(AS(z)+wf)=1;
R z;
} /* allocate result for grd1sp__ */
int javaWd(JNIEnv *env, jobject obj, J jt,int type, A w, A *pz, const char*locale)
{
LOGD("javaWd");
int i,j,len,rc=0;
if(wdId == 0) {
jclass the_class = (*env)->GetObjectClass(env,obj);
wdId = (*env)->GetMethodID(env,the_class,"wd","(I[I[Ljava/lang/Object;[Ljava/lang/Object;Ljava/lang/String;)I" );
(*env)->DeleteLocalRef(env,the_class);
}
if(wdId == 0) {
LOGD("failed to get the method id for wd" );
return 3;
}
// check argument type
if (BOX&AT(w)) {
A* wi= (A*)AV(w);
for (i=0; i<AN(w); i++)
if(!(INT&AT(*(wi+i))||LIT&AT(*(wi+i)))) {
LOGD("argument error for wd box" );
rc=3;
break;
}
} else if (AN(w) && !(INT&AT(w)||LIT&AT(w))) {
LOGD("argument error for wd non-box" );
rc=3;
}
if (rc) {
return rc;
}
// inta: type shape0 shape1 .... repeat for each inarr element
int ninarr=(BOX&AT(w))?AN(w):1;
jclass objcls = (*env)->FindClass(env,"java/lang/Object");
jobject inarr= (*env)->NewObjectArray(env, ninarr, objcls, 0);
jobject outarr= (*env)->NewObjectArray(env, 2, objcls, 0);
(*env)->DeleteLocalRef(env,objcls);
jintArray inta= (*env)->NewIntArray(env, 3*ninarr);
jint* pinta = (*env)->GetIntArrayElements(env, inta, 0);
A* w1;
if (BOX&AT(w))
w1= (A*)AV(w);
else
w1= &w;
for (i=0; i<ninarr; i++) {
if (LIT&AT(*w1) || 0==AN(*w1)) {
pinta[3*i] = LIT;
if (AR(*w1)>1 && AN(*w1)) {
pinta[3*i+1] = (AS(*w1))[0];
pinta[3*i+2] = (AS(*w1))[1];
} else {
pinta[3*i+1] = -1;
pinta[3*i+2] = -1;
}
jbyteArray bytea= (*env)->NewByteArray(env, AN(*w1));
jbyte* pbytea = (*env)->GetByteArrayElements(env, bytea, 0);
memcpy(pbytea, CAV(*w1), AN(*w1));
(*env)->ReleaseByteArrayElements(env, bytea, pbytea, 0);
(*env)->SetObjectArrayElement(env, inarr, i, bytea);
(*env)->DeleteLocalRef(env,bytea);
} else if (INT&AT(*w1)) {
pinta[3*i] = INT;
if (AR(*w1)>1) {
pinta[3*i+1] = (AS(*w1))[0];
pinta[3*i+2] = (AS(*w1))[1];
} else {
pinta[3*i+1] = -1;
pinta[3*i+2] = -1;
}
jintArray intb= (*env)->NewIntArray(env, AN(*w1));
#if SY_64
jint *pintb = (*env)->GetIntArrayElements(env, intb, 0);
for (j=0; j<AN(*w1); j++) pintb[j]=(jint)*(AV(*w1)+j);
(*env)->ReleaseIntArrayElements(env, intb, pintb, 0);
#else
(*env)->SetIntArrayRegion(env, intb, 0, AN(*w1), (jint*)AV(*w1));
#endif
(*env)->SetObjectArrayElement(env, inarr, i, intb);
(*env)->DeleteLocalRef(env,intb);
}
w1++;
}
(*env)->ReleaseIntArrayElements(env, inta, pinta, 0);
jstring slocale = (*env)->NewStringUTF(env,locale);
rc = (*env)->CallIntMethod(env,obj,wdId,(jint)type,inta,inarr,outarr,slocale);
(*env)->DeleteLocalRef(env,inta);
(*env)->DeleteLocalRef(env,inarr);
(*env)->DeleteLocalRef(env,slocale);
// (*env)->ExceptionClear(env);
if (rc<0) {
jobject array = (*env)->GetObjectArrayElement(env, outarr, 0);
jobject inta = (*env)->GetObjectArrayElement(env, outarr, 1);
if (0==array || 0==inta) {
if (0==array) LOGD("array null");
if (0==inta) LOGD("inta null");
rc=3;
} else {
int leni= (*env)->GetArrayLength(env, inta);
jint *pinta = (*env)->GetIntArrayElements(env, inta, 0);
I itype= pinta[0];
I ishape[2];
ishape[0]= pinta[1]; // -1 if not rank-2
ishape[1]= pinta[2];
(*env)->ReleaseIntArrayElements(env, inta, pinta, 0);
len= (*env)->GetArrayLength(env, array);
if (itype==LIT) {
if (ishape[0]==-1) {
GATV(*pz,LIT,len,1,0);
} else {
GATV(*pz,LIT,len,2,ishape);
}
(*env)->GetByteArrayRegion(env, array, 0, len, CAV(*pz));
} else if (itype==INT) {
if (ishape[0]==-1) {
GATV(*pz,INT,len,1,0);
} else {
GATV(*pz,INT,len,2,ishape);
}
#if SY_64
jint *parray = (*env)->GetIntArrayElements(env, array, 0);
for (j=0; j<len; j++) *(AV(*pz)+j)=parray[j];
(*env)->ReleaseIntArrayElements(env, array, parray, 0);
#else
(*env)->GetIntArrayRegion(env, array, 0, len, (jint*)AV(*pz));
#endif
} else {
LOGD("result not string or integers");
rc=3;
}
}
(*env)->DeleteLocalRef(env,array);
(*env)->DeleteLocalRef(env,inta);
}
(*env)->DeleteLocalRef(env,outarr);
return (rc>0)?3:rc;
}
static A jtrankingb(J jt,A w,I wf,I wcr,I m,I n,I k){A z;C*wv;I i,j,p,t,yv[16],*zv;
p=2==k?4:16; wv=CAV(w);
GATV(z,INT,m*n,1+wf,AS(w)); if(!wcr)*(AS(z)+wf)=1; zv=AV(z);
if(2==k){US*v;
for(i=0;i<m;++i){
memset(yv,C0,p*SZI);
for(j=0,v=(US*)wv;j<n;++j)switch(*v++){
case BS00: ++yv[0]; break;
case BS01: ++yv[1]; break;
case BS10: ++yv[2]; break;
case BS11: ++yv[3]; break;
}
RANKINGSUMSCAN;
for(j=0,v=(US*)wv;j<n;++j)switch(*v++){
case BS00: *zv++=yv[0]++; break;
case BS01: *zv++=yv[1]++; break;
case BS10: *zv++=yv[2]++; break;
case BS11: *zv++=yv[3]++; break;
}
wv+=n*k;
}}else{int*v;
for(i=0;i<m;++i){
memset(yv,C0,p*SZI);
for(j=0,v=(int*)wv;j<n;++j)switch(*v++){
case B0000: ++yv[ 0]; break;
case B0001: ++yv[ 1]; break;
case B0010: ++yv[ 2]; break;
case B0011: ++yv[ 3]; break;
case B0100: ++yv[ 4]; break;
case B0101: ++yv[ 5]; break;
case B0110: ++yv[ 6]; break;
case B0111: ++yv[ 7]; break;
case B1000: ++yv[ 8]; break;
case B1001: ++yv[ 9]; break;
case B1010: ++yv[10]; break;
case B1011: ++yv[11]; break;
case B1100: ++yv[12]; break;
case B1101: ++yv[13]; break;
case B1110: ++yv[14]; break;
case B1111: ++yv[15]; break;
}
RANKINGSUMSCAN;
for(j=0,v=(int*)wv;j<n;++j)switch(*v++){
case B0000: *zv++=yv[ 0]++; break;
case B0001: *zv++=yv[ 1]++; break;
case B0010: *zv++=yv[ 2]++; break;
case B0011: *zv++=yv[ 3]++; break;
case B0100: *zv++=yv[ 4]++; break;
case B0101: *zv++=yv[ 5]++; break;
case B0110: *zv++=yv[ 6]++; break;
case B0111: *zv++=yv[ 7]++; break;
case B1000: *zv++=yv[ 8]++; break;
case B1001: *zv++=yv[ 9]++; break;
case B1010: *zv++=yv[10]++; break;
case B1011: *zv++=yv[11]++; break;
case B1100: *zv++=yv[12]++; break;
case B1101: *zv++=yv[13]++; break;
case B1110: *zv++=yv[14]++; break;
case B1111: *zv++=yv[15]++; break;
}
wv+=n*k;
}}
R z;
} /* /:@/: w where w is boolean and items have length 2 or 4 */
