jtintersect only for 64-bit, & support cct

Author: HenryHRich

jsrc/cf.c

@@ -191,7 +191,7 @@ A jtfolk(J jtfg,A f,A g,A h){F12IP;A p,q,x,y;AF f1=0,f2=0;B b;C c,fi,gi,hi;I fla
   f2=fork2tbl[fline][hcol]; f2=(I)jtfg&JTFOLKNOHFN?jtfolk2:f2;  // NOHFN means the caller is going to fool with the result fork, so the EP is unreliable
  }else{hcol=-1;}   // select the value we will put into localuse: hcol=-1 means cct, other hcol=routine address of h or h@]
 
- fdeffillall(z,flag2,CFORK,VERB, f1,f2, f,g,h, flag, RMAX,RMAX,RMAX,fffv->localuse.lu0.cachedloc=0,if(hcol<0)FAV(z)->localuse.lu1.cct=cct;else FAV(z)->localuse.lu1.fork2hfn=hcol<=2?hv->valencefns[1]:FAV(hv->fgh[0])->valencefns[0]);
+ fdeffillall(z,flag2,CFORK,VERB, f1,f2, f,g,h, flag, RMAX,RMAX,RMAX,fffv->localuse.lu0.cct=cct,if(hcol<0)FAV(z)->localuse.lu1.cct=cct;else FAV(z)->localuse.lu1.fork2hfn=hcol<=2?hv->valencefns[1]:FAV(hv->fgh[0])->valencefns[0]);
     // set localuse: for intersect or comparison combination, cct; for echt fork, the h routine to call
  R z;
 }

jsrc/cp.c

@@ -319,7 +319,7 @@ DF2(jtpowop){F12IP;B b;V*v;
  A z; fdefallo(z)  // allocate normal result area
  AF f1,f2; I flag;  // derived-verb handlers; flags for the verb we build
  A h;  // A block for the power list converted to integer (initially, remaining for jtply12 only); u^:_1 (for jtinv[12]); 0 for others
- I encn;  // the encoded form of the integer power to be passed to pow12n
+ I encn; D cct=0.0;  // the encoded form of the integer power to be passed to pow12n; cct for setintersect (default to none)
  if(AT(w)&VERB){
   // u^:v.  Create derived verb to handle it. The action routines are inplaceable; take NOLOCCHG from u and v, inplaceability from u
   f1=f2=jtpowv12cell; h=0; flag=(FAV(a)->flag&FAV(w)->flag&VNOLOCCHG+VNONAME+VNOSELF);
@@ -368,13 +368,23 @@ DF2(jtpowop){F12IP;B b;V*v;
       f2=jtinv2; f1=jtinv1; if(nameless(a)){WITHMSGSOFF(if(h=inv(a)){f1=jtinvh1;flag=FAV(h)->flag&VNOLOCCHG+VNONAME+VNOSELF;}else{f1=jtinverr;})} // h must be valid A block for free.  If no names in w, take the inverse.  If it doesn't exist, fail the monad but keep the dyad going
      }else flag=FAV(a)->flag&VNONAME+VNOSELF;     // if u^:_, never allow inplace assignment since we are converging
      // Note: negative powers other than _1 are resolved in the action routine
-    }else if(n==2&&a==ds(CLESS)){f2=jtintersect;}  // -.^:2, set intersection, which allows inplacing
+    }
+#if C_CRC32C && SY_64 && (C_AVX2 || EMU_AVX2)
+    else if(unlikely(n==2)){
+     I aid=FAV(a)->id; if(unlikely(aid==CFIT)){cct=FAV(a)->localuse.lu1.cct; aid=FAV(FAV(a)->fgh[0])->id;}
+     if(aid==CLESS){  // -.^:2  and -.!.f^:2
+      f2=jtintersect;  // treat the compound as a primitive of its own
+      flag|=(7+(((IINTER-II0EPS)&0xf)<<3));  // flag it like -.
+      // if tolerance given on second -., it is now in cct
+     }
+    }
+#endif
     encn=(ABS(n)<<POWERABSX)+(n<0?POWERANEG:0); encn=n==IMIN?((I)-1*POWERABS)+POWERADOWHILE:encn;  // save the power, in flagged form, for powatom12
    }else{f1=f2=jtply12; flag=FAV(a)->flag&VNONAME+VNOSELF;}  // non-atomic power: handle general case, which does not support inplacing (since it might converge)
    // fall through to create result
   }  // end of 'u^:numeric'
  }  // end of 'u^:n'
  fdeffill(z,0,CPOWOP,VERB, f1,f2, a,w,h,flag, RMAX,RMAX,RMAX);   // Create derived verb: pass in integer powers or inverse as h
- FAV(z)->localuse.lu1.poweratom=encn;   // pass power info for powatom12, garbage for others
+ FAV(z)->localuse.lu1.poweratom=encn; FAV(z)->localuse.lu0.cct=cct;  // pass power info for powatom12, garbage for others
  RETF(z);
 }

jsrc/jtype.h

@@ -1147,7 +1147,7 @@ typedef struct{
  I n;                   /* maximum number of records                       */
  I i;                   /* index of next record to be written              */
  I s;                   /* initial bytesmax value                          */
- I pmlvl;               // sampling level, set > 0 to start sampling
+ I pmlvl;               // counter, set > 0 to start sampling
  B rec;                 /* what to record (0 entry & exit; 1 all)          */
  B trunc;               /* what to do on overflow (0 wrap; 1 truncate)     */
  B wrapped;             /* 1 iff wrapping has happened                     */
@@ -1199,6 +1199,7 @@ typedef struct {
     A cachedloc;   //  for namerefs ('name'~), the locale address if the name is a direct named lookup (after the first reference)
     A gerundself;  // in gerund iterators, the address of the self block for m@.v, for diagnostic purposes
     AF modatomfn;  // in u m. n, the verb to process atoms of u
+    D cct;  // cct if given for setintersect -.^:2    [-.-.    [e.#
    } lu0;
    // end of first cacheline, which is not used much during execution
    // the rest do not require both cachelines in 64-bit

jsrc/viavx.c

@@ -1268,6 +1268,7 @@ F2(jtless){F12IP;A x=w;I ar,at,k,r,*s,wr,*ws;
  EPILOG(x);
 }    /* a-.w */
 
+#if C_CRC32C && SY_64 && (C_AVX2 || EMU_AVX2)
 // x ([ -. -.[!.f]) y.  does not have IRS, supports inplacing on a (the unhashed argument)
 DF2(jtintersect){F12IP;A x=w;I ar,at,k,r,*s,wr,*ws;
  ARGCHK2(a,w);
@@ -1277,14 +1278,14 @@ DF2(jtintersect){F12IP;A x=w;I ar,at,k,r,*s,wr,*ws;
  if(unlikely(ar>1+wr))R take(zeroionei(0),a);  // if w's rank is smaller than that of a cell of a, nothing can be common, return no items
  if(unlikely(MIN(ai,wi)==0))R take(zeroionei(0),a);  // if either arg is empty, nothing can be common, return no items
  jtfg=MOVEIP0A(jtfg);  // only our a argument can be inplaced, and it moves to y in all uses
- PUSHCCTIF(FAV(self)->localuse.lu1.cct,FAV(self)->localuse.lu1.cct!=0)   // if there is a CT, use it  *** no errors till cct restored ***
+ PUSHCCTIF(FAV(self)->localuse.lu0.cct,FAV(self)->localuse.lu0.cct!=0)   // if there is a CT, use it  *** no errors till cct restored ***
  if(unlikely(ar==wr+1)){  // is just 1 cell of y, with x a list of such cells?
   if(wr==0)x=eq(a,w); else IRS2(a,w,0,wr,wr,jtmatch,x); RZGOTO(x,errexit) x=jtrepeat(jtfg,x,a);  // y has rank 1 less than x, execute as ((x = y) # x) (y atomic) or ((x -:"yr) # x) if (y array).  Inplace x on the #.  Use IRS and leave comparison tolerance as set
  }else{
   // if w's rank is larger than that of a cell of a, reheader w to look like a list of such cells
   if(unlikely((-wr&-(r^wr))<0)){RZGOTO(x=virtual(w,0,r),errexit); AN(x)=wn; s=AS(x); ws=AS(w); k=ar>wr?0:1+wr-r; I s0; PRODX(s0,k,ws,1) s[0]=s0; MCISH(1+s,k+ws,r-1);}  //  use fauxvirtual here
   // comparison tolerance may be encoded in h - apply it if so
-  D savcct = jt->cct;
+// obsolete   D savcct = jt->cct;
   // if nothing special (like sparse, or incompatible types, or x requires conversion) do the fast way; otherwise (x e. y) # x 
   // because LESS allocates a large array to hold all the values, we use the slower, less memory-intensive, version if a is mapped
   // Don't revert to fork!  localuse.lu1.fork2hfn is not set
@@ -1296,6 +1297,7 @@ errexit:;
  if(unlikely(at&BOX)){jtfg=MOVEIPA0(jtfg); PRISTXFERAF(x,a)}  // the boxes in w cannot get to the result, even though their values participate; so pristinity depends entirely on original a
  EPILOG(x);
 }
+#endif
 
 // x e. y
 F2(jteps){F12IP;I l,r;

test/g121.ijs

@@ -452,6 +452,10 @@ s f&>/ t
 NB. comparison tolerance
 10 = # (1 + 1e_15 * i. 10) ([ -. -.) 1
 1 = # (1 + 1e_15 * i. 10) ([ -.!.0 -.!.0) 1
+10 = # (1 + 1e_15 * i. 10) (e. # [) 1
+1 = # (1 + 1e_15 * i. 10) (e.!.0 # [) 1
+10 = # (1 + 1e_15 * i. 10) (-.^:2) 1
+1 = # (1 + 1e_15 * i. 10) (-.!.0^:2) 1
 
 NB. Verify -.!.0 in the middle is treated like -.
 yy =: 1e6 $ 1. 2.