small tweaks incl g128x

Author: HenryHRich

jsrc/ca.c

@@ -115,7 +115,7 @@ static DF2(jtupon20atom){F2PREFIP; if(unlikely((AN(a)|AN(w))>1&&JT(jt,deprecct)!
 
 // special lightweight case for u@[ and u@].
 static DF1(onright1){F1PREFIP; R (FAV(FAV(self)->fgh[0])->valencefns[0])(jtinplace,w,FAV(self)->fgh[0],FAV(self)->fgh[0]);}  // pass straight through.  All we do here is set self.  Leave inplaceability unchanged
-static DF2(onleft2){F2PREFIP; R (FAV(FAV(self)->fgh[0])->valencefns[0])((J)(((I)jtinplace&~(JTINPLACEA+JTINPLACEW))+(((I)jtinplace>>(JTINPLACEAX-JTINPLACEWX))&(JTINPLACEA>>(JTINPLACEAX-JTINPLACEWX)))),a,FAV(self)->fgh[0],FAV(self)->fgh[0]);}  // move inplaceable a to w
+static DF2(onleft2){F2PREFIP; R (FAV(FAV(self)->fgh[0])->valencefns[0])((J)(((I)jtinplace&~(JTINPLACEA+JTINPLACEW))+(((I)jtinplace>>(JTINPLACEAX-JTINPLACEWX))&(JTINPLACEA>>(JTINPLACEAX-JTINPLACEWX)))),a,FAV(self)->fgh[0],FAV(self)->fgh[0]);}  // move inplaceable a to w, pass other JT flags
 static DF2(onright2){F2PREFIP; R (FAV(FAV(self)->fgh[0])->valencefns[0])((J)((I)jtinplace&~JTINPLACEA),w,FAV(self)->fgh[0],FAV(self)->fgh[0]);}  // keep inplaceable w
 
 // u@n
@@ -319,7 +319,7 @@ F2(jtatco){F2PREFIP;A f,g;AF f1=on1cell,f2=jtupon2cell;C c,d,e;I flag, flag2=0,m
   case CQUERY&0x3f:  if((d&~1)==CPOUND){f2=jtrollk; flag&=~VJTFLGOK2;}  break;  // x ?@:# y or x ?@:$ y
   case CQRYDOT&0x3f: if((d&~1)==CPOUND){f2=jtrollkx; flag&=~VJTFLGOK2;} break;  // x ?.@:# y or x ?.@:$ y
   case CICAP&0x3f:   if(d==CNE){f1=jtnubind; flag&=~VJTFLGOK1;} else if(FIT0(CNE,wv)){f1=jtnubind0; flag&=~VJTFLGOK1;}else if(d==CEBAR){f2=jtifbebar; flag&=~VJTFLGOK2;} break;  // I.@:~: y  I.@:(~:!.0) y  x I.@:E. y
-  case CAMP&0x3f:    {m=(e&~2)==CIOTA?e:m; I j=-1; j=g==num(0)?0:j;  j=g==num(1)?1:j; m|=j; break;}   // i.@0/1@:g    i:@0/1@:g
+  case CAMP&0x3f:    {m=(e&~2)==CIOTA?e:m; I j=-1; j=g==num(0)?0:j;  j=g==num(1)?1:j; m|=j; break;}   // i.&0/1@:g    i:&0/1@:g   note 0/1 must be boolean SDTs
   case CSLASH&0x3f:  //  f/@:g where f is not a gerund
    if(FAV(f)->flag&FAV(w)->flag&VISATOMIC2){f2=jtfslashatg;}  // f/@:g when f and g are both atomic
    if(d==CCOMMA){f1=jtredravel;}
@@ -494,8 +494,10 @@ F2(jtamp){F2PREFIP;A h=0;AF f1,f2;B b;C c;I flag,flag2=0,linktype=0,mode=-1,p,r;
     mode=((II0EPS-1+((p&VFCOMPCOMP)>>3))&0xf)+1;  // e.-compound&n including e. -. ([ -. -.) or any i.&1@:e.  - LESS/INTER not in 32-bit
     if(mode==IINTER){cct=FAV(va)->localuse.lu1.cct; b=cct!=0;}  // ([-.-.) always has cct, but it might be 0 indicating default
     {PUSHCCTIF(FAV(va)->localuse.lu1.cct,b) h=indexofsub(mode,w,mark); cct=jt->cct; POPCCT f1=ixfixedright; flag&=~VJTFLGOK1; RZ(h)}  // m&i[.:][!.f], and remember cct when we created the table
-   }else if(unlikely((c^visa)==CWORDS)){RZ(a=fsmvfya(a)); f1=jtfsmfx; flag&=~VJTFLGOK1;   // m&;:
-   }else if(unlikely((c^visa)==CIBEAM)){if(FAV(w)->localuse.lu1.foreignmn[0]==128&&FAV(w)->localuse.lu1.foreignmn[1]==3){RZ(h=crccompile(a)); f1=jtcrcfixedleft; flag&=~VJTFLGOK1; } // m&128!:3  scaf use rtn addr
+ // obsolete    }else if(unlikely((c^visa)==CWORDS)){RZ(a=fsmvfya(a)); f1=jtfsmfx; flag&=~VJTFLGOK1;   // m&;:
+   }else if(unlikely(FAV(w)->valencefns[0]==jtwords)){RZ(a=fsmvfya(a)); f1=jtfsmfx; flag&=~VJTFLGOK1;   // m&;:
+ // obsolete   }else if(unlikely((c^visa)==CIBEAM)){if(FAV(w)->localuse.lu1.foreignmn[0]==128&&FAV(w)->localuse.lu1.foreignmn[1]==3){RZ(h=crccompile(a)); f1=jtcrcfixedleft; flag&=~VJTFLGOK1; } // m&128!:3
+   }else if(unlikely(FAV(w)->valencefns[0]==jtcrc1)){RZ(h=crccompile(a)); f1=jtcrcfixedleft; flag&=~VJTFLGOK1; // m&128!:3
    }
   }
   fdeffillall(z,0,CAMP,VERB, f1,with2, a,w,h, flag, RMAX,RMAX,RMAX,fffv->localuse.lu0.cachedloc=0,FAV(z)->localuse.lu1.cct=cct);

jsrc/cf.c

@@ -59,7 +59,8 @@ A jtfolk(J jt,A f,A g,A h){F2PREFIP;A p,q,x,y;AF f1=0,f2=0;B b;C c,fi,gi,hi;I fl
   // f will be INCORPed by fdef
   flag=(hv->flag&(VJTFLGOK1|VJTFLGOK2))+((gv->flag&hv->flag)&VASGSAFE);  // We accumulate the flags for the derived verb.  Start with ASGSAFE if all descendants are.
   fline=5;  // set left argtype
-  if(((AT(f)^B01)|AR(f)|BAV0(f)[0])==0&&BOTHEQ8(gi,hi,CEPS,CDOLLAR))f1=jtisempty;  // 0 e. $, accepting only boolean 0
+// obsolete   if(((AT(f)^B01)|AR(f)|BAV0(f)[0])==0&&BOTHEQ8(gi,hi,CEPS,CDOLLAR))f1=jtisempty;  // 0 e. $, accepting only boolean 0
+  if(f==num(0)&&BOTHEQ8(gi,hi,CEPS,CDOLLAR))f1=jtisempty;  // 0 e. $, accepting only SDT boolean 0
   if(LIT&AT(f)&&1==AR(f)&&BOTHEQ8(gi,hi,CTILDE,CFORK)&&CFROM==ID(gv->fgh[0])){
    x=hv->fgh[0];
    if(LIT&AT(x)&&1==AR(x)&&CIOTA==ID(hv->fgh[1])&&CRIGHT==ID(hv->fgh[2])){f1=jtcharmap;}  // (N {~ N i. ])  supports inplacing
@@ -92,7 +93,7 @@ A jtfolk(J jt,A f,A g,A h){F2PREFIP;A p,q,x,y;AF f1=0,f2=0;B b;C c,fi,gi,hi;I fl
    if(gi==CPOUND){f1=hi==CCOMMA?jtnatoms:f1; f1=hi==CDOLLAR?jtrank:f1;}  // [: # ,   [: # $
                break; /* [: g h */
   case CSLASH: if(BOTHEQ8(gi,hi,CDIV,CPOUND)&&CPLUS==FAV(fv->fgh[0])->id){f1=jtmean; flag|=VIRS1; flag &=~(VJTFLGOK1);} break;  /* +/%# */
-  case CAT:    /* <"1@[ { ] */
+  case CAT: case CATCO:    /* <"1@[ { ]  or <"1@:[ { ]  */
    if(BOTHEQ8(gi,hi,CLBRACE,CRIGHT)){                                   
     p=fv->fgh[0]; q=fv->fgh[1]; 
     if(CQQ==FAV(p)->id&&CLEFT==ID(q)&&(CLT==ID(FAV(p)->fgh[0])&&FAV(p)->fgh[1]==num(1))){f2=jtsfrom; flag &=~(VJTFLGOK2);}

jsrc/cip.c

@@ -1128,7 +1128,7 @@ DF1(jtludecompg){F1PREFIP;PROLOG(823);
 // the ith element of the permutation is the original row of row i of LU
 // Bivalent.  a, if given, is the sequence of thresholds to try
 DF2(jtludecomp){F1PREFIP;PROLOG(823);
- static D pthresh[2]={1e-6,0}, *pivotthresh; I npivotthresh, curpivotthreshx=0;  // list of successive thresholds for pivots, last one usually 0.0
+ static D pthresh[2]={1e-6,0}, *pivotthresh; I npivotthresh, curpivotthreshx;  // list of successive thresholds for pivots, last one usually 0.0
  if(AT(w)&NOUN){ASSERT(AR(a)<=1,EVRANK); ASSERT(AN(a)>0,EVLENGTH) if(unlikely(!(AT(a)&FL)))RZ(a=cvt(FL,a)); pivotthresh=DAV(a); npivotthresh=AN(a);}else{w=a; pivotthresh=pthresh; npivotthresh=sizeof(pthresh)/sizeof(pthresh[0]);}
 #if C_AVX2 || EMU_AVX2
  // We operate on 4x4 blocks of A, which we transform into 4x4 blocks of LU.  The ravel of each LU block is stored for cache ease,
@@ -1191,6 +1191,7 @@ DF2(jtludecomp){F1PREFIP;PROLOG(823);
 // obsolete   D *wluv=wclv; I wlustride=BLKSZ*wn;  // pointer to next input values in A, and offset to next.  We start going south
 // obsolete   D *nextfetchaddr=wclv;  // the address of the block being fetched into nexta0..3.  Init to the corner which we just prefetched
   scv=LBLOCK(nr-1-r,nr-1-r);   // start store at corner block.  It will not advance until pivots have been found
+  curpivotthreshx=0;  // start every ring looking for large pivots, even if we had to relax the criterion for an earlier ring
 
  restartring:; // *** restart point after permutation has been updated.  We restart the ring at the corner, which will succeed
 // obsolete   D (*llv)[BLKSZ][BLKSZ]=LBLOCK(nr-1-r,0), (*luv)[BLKSZ][BLKSZ]=UBLOCK(0,nr-1-r), (*prechv)[BLKSZ][BLKSZ]=llv+nr;  // start point of dot-products (both going L-to-R), startpoint of next dot-product (first L block)

jsrc/io.c

@@ -353,7 +353,6 @@ static C* nfeinput(JS jt,C* s){A y;
 // if *p is (C)1 (which comes from m : 0), the request is for unprocessed 'literal input'
 // otherwise processed in inpl
 // Lines may come from a script, in which case return 0 on EOF, but EVINPRUPT is still possible as an error
-// scaf should rewrite this interface to keep the control info in locals in 0!:x
 A jtjgets(JJ jt,C*p){A y;B b;C*v;I j,k,m,n;UC*s;
  __atomic_store_n(&IJT(jt,adbreak)[0],0,__ATOMIC_RELEASE);  // this is CLRATTN but for the definition of JT here
  if(b=1==*p)p=""; /* 1 means literal input; remember & clear prompt */

jsrc/jtype.h

@@ -615,9 +615,9 @@ typedef I SI;
 #define ACSETPERM(x)    {AC(x)=ACPERMANENT+100000; __atomic_fetch_or(&AFLAG(x),(AT(x)&RECURSIBLE),__ATOMIC_ACQ_REL);}  // Make a block permanent from now on.  In case other threads have committed to changing the usecount, make it permanent with a margin of safety
 #define SGNIFPRISTINABLE(c) ((c)+ACPERMANENT)  // sign is set if this block is OK in a PRISTINE boxed noun
 // s is an expression that is neg if it's OK to inplace
-#define ASGNINPLACENEG(s,w)  ((s)&(AC(w)|SGNIF(jt->zombieval==w,0)))   // neg if OK to inplace ordinary operation
-#define ASGNINPLACESGN(s,w)  (ASGNINPLACENEG(s,w)<0)   // OK to inplace ordinary operation
-#define ASGNINPLACESGNNJA(s,w)  ASGNINPLACESGN(s,w)  // OK to inplace ordinary operation
+#define ASGNINPLACENEG(s,w)  ((s)&(AC(w)|SGNIF(jt->zombieval==w,0)))   // neg if OK to inplace ordinary operation, either because the block is inplaceable or because it's an assignment to zombie
+#define ASGNINPLACESGN(s,w)  (ASGNINPLACENEG(s,w)<0)
+#define ASGNINPLACESGNNJA(s,w)  ASGNINPLACESGN(s,w)
 // define virtreqd and set it to 0 to start
 // This is used in apip.  We must ALWAYS allow inplacing for NJA types, but for ordinary inplacing we don't bother if the number of atoms of w pushes a over a power-of-2 boundary
 #define EXTENDINPLACENJA(a,w) \

jsrc/sc.c

@@ -55,10 +55,10 @@ DF2(jtunquote){A z;
    // If it has a (necessarily direct named) locative, we must fetch the locative so we switch to it
    if(unlikely(((A)(I)(NAV(thisname)->flag&NMLOC))!=0)){  // most verbs aren't locatives. if no direct locative, leave global unchanged
     if(unlikely((explocale=FAV(self)->localuse.lu0.cachedloc)==0)){  // if we have looked it up before, keep the lookup
-     RZSUFF(explocale=stfindcre(AN(thisname)-NAV(thisname)->m-2,1+NAV(thisname)->m+NAV(thisname)->s,NAV(thisname)->bucketx),z=0; goto exitname;);  //  extract locale string, find/create locale  scaf why create?
+     RZSUFF(explocale=stfind(AN(thisname)-NAV(thisname)->m-2,1+NAV(thisname)->m+NAV(thisname)->s,NAV(thisname)->bucketx),z=0; goto exitname;);  //  extract locale string, find locale, which must exist
      FAV(self)->localuse.lu0.cachedloc=explocale;  // save named lookup calc for next time
     }
-    flgd0cpC|=((explocale!=jt->global)&~(LXAV0(explocale)[SYMLEXECCT]>>EXECCTPERMX))<<FLGLOCINCRDECRX;  // remember that there is a change of locale
+    flgd0cpC|=((explocale!=jt->global)&~(LXAV0(explocale)[SYMLEXECCT]>>EXECCTPERMX))<<FLGLOCINCRDECRX;  // remember that there is a change of locale, but not if it is permanent
     SYMSETGLOBAL(explocale);   // switch to the (possibly new) locale.
    }
    flgd0cpC|=FLGCACHED;  // indicate cached lookup, which also tells us that we have not ra()d the name
@@ -176,7 +176,7 @@ DF2(jtunquote){A z;
  // be horrid.  To avoid that, we update execct only during a change
  // at this point jt->global is the new locale to use (possibly inherited).  If LOCINCRDECR is set,
  // explocale also holds that value.  LOCINCRDECR is set if we should incr/decr explocale, which is true if it changes
- // to a non-permanent locale (we don't want executions in z to hammer the z count)
+ // to a non-permanent locale (we don't want executions in z/base/... to hammer the z count)
  if(flgd0cpC&FLGLOCINCRDECR){INCREXECCT(explocale);}  // incr execct in newly-starting locale
  // scaf if someone deletes the locale before we start it, we are toast
  // ************** from here on errors must (optionally) decr explocale  and unra() before exiting
@@ -263,7 +263,8 @@ exitfa:;  // error point for errors after symbol res.
 if(likely(!(flgd0cpC&(FLGCACHED|FLGPSEUDO)))){fanamedacv(fs);}  // unra the name if it was looked up from the symbol tables
 // obsolete if(0){exitname: SYMSETGLOBALINLOCAL(jt->locsyms,stack.global);}  // error point for name errors.  In case we put jt->global into jt->locsyms, undo that
 exitname:; // error point for name errors.
- SYMSETGLOBALINLOCAL(stack.locsyms,stack.global);   // we will restore jt->global, which might have changed early or as late as the deletion; make sure locsyms matches
+ SYMSETGLOBALINLOCAL(stack.locsyms,stack.global);   // we will restore jt->global, which might have changed early or as late as the deletion; make sure locsyms matches.  global and AKGST always match for the named explicit routine that is running.
+    // if an explicit routine calls a tacit name via locative, globals and AKGST will diverge while the tacit verb runs; if the tacit verb then calls a (possibly named) explicit, the explicit's u. will be from the earlier explicit, not the intervening tacit.
 #if C_AVX2 || EMU_AVX2
  _mm256_storeu_si256((__m256i *)&jt->parserstackframe.sf,_mm256_loadu_si256((__m256i *)&stack));
 #else

jsrc/v.c

@@ -164,7 +164,7 @@ DF1(jticap){A a,e;I n;P*p;
  R likely((B01&AT(w))!=0) ? ifb(n,BAV(w)) : repeat(w,IX(n));
 }
 
-DF1(jtcharmap){F1PREFIP; A z;B bb[256];I k,n,wn;UC c,*u,*v,zz[256];  // scaf should inplace w
+DF1(jtcharmap){F1PREFIP; A z;B bb[256];I k,n,wn;UC c,*u,*v,zz[256];
  A x=FAV(FAV(self)->fgh[2])->fgh[0], y=FAV(self)->fgh[0];  // extract translation tables
  RZ(w&&x&&y);
  if(!(LIT&AT(w)))R from(indexof(x,w),y);

jsrc/x15.c

@@ -1190,7 +1190,7 @@ static B jtcdexec1(J jt,CCT*cc,C*zv0,C*wu,I wk,I wt,I wd){A*wv=(A*)wu,x,y,*zv;B
 #endif
    // remember inplace-conversions (i. e. conversions to smaller precisions, which can be handled in place).  Conversions to larger precisions, or to other types, were handled above.
    // Here we see if a conversion will be needed and add it to the list of inplace conversions
-   CDASSERT(ISDENSETYPE(xt,B01+LIT+C2T+C4T+INT+INT2+INT4+FL+CMPX),per);  // verify J type is DIRECT  scaf not needed, impossible
+// obsolete    CDASSERT(ISDENSETYPE(xt,B01+LIT+C2T+C4T+INT+INT2+INT4+FL+CMPX),per);  // verify J type is a C native type
    if(unlikely(xlgsz>clgsz)){  // x is bigger than needed (ignoring cases of LIT buffers)
     cip[cipcount].v=xv; cip[cipcount].n=xn; cip[cipcount].t=ctype; cip[cipcount].cxlgsz=4*clgsz+xlgsz;   // save conversion info
     ++cipcount;

test/g128x.ijs

@@ -76,7 +76,7 @@ for_dim. 2 + 20 ?@$ 40 do.
   l =. 1. todiag l * 0.5 > ($l) ?@$ 0
   a =. ({~ ?~@#) l +/ . * r
   'p lr' =. (1 0.01 1e_6 0) 128!:10 perma=: a
-  assert. 1e_9 > >./ | , (p { a) - lrtoa lr
+  assert. 1e_8 > >./ | , (p { a) - lrtoa lr
 end.
 1
 }}^:IF64 1 NB. all J64 support EMU_AVX2 true fma