Short-caching of verbs broken

Author: HenryHRich

jsrc/cc.c

@@ -141,7 +141,7 @@ DF2(jtspecialatoprestart){F12IP;
 
 // x <;.0 y  and  x (<;.0~ -~/"2)~ y   where _1 { $x is 1 (i. e. 1 dimension of selection)  localuse distinguishes the two cases (relative vs absolute length)
 // We go for minimum overhead in the box allocation and copy
-DF2(jtboxcut0){F12IP;A z;
+DF2(jtboxcut0){F12IP;A z;I i;
  ARGCHK2(a,w);
  // NOTE: this routine is called from jtwords.  In that case, self comes from jtwords and is set up with the parm for x (<;.0~ -~/"2)~ y but with no failover routine.
  // Thus, the preliminary tests must not cause a failover.  They don't, because the inputs from jtwords are known to be well-formed
@@ -159,21 +159,21 @@ DF2(jtboxcut0){F12IP;A z;
  I resatoms; PROD(resatoms,f,AS(a)); I cellsize; PROD(cellsize,wr-1,AS(w)+1);
  I k=bplg(t); C *wv=CAV(w);  // k is length of an atom of w
  // allocate the result area
- GATV(z,BOX,resatoms,f,AS(a)); if(resatoms==0){RETF(z);}  // could avoid filling with 0 if we modified AN after error, or cleared after *tnextpushp
+ GATV(z,BOX,resatoms,f,AS(a)); if(resatoms==0){RETF(z);}  // scaf could avoid filling with 0 if we modified AN after error, or cleared after *tnextpushp
   // We have allocated the result; now we allocate a block for each cell of w and copy
   // the w values to the new block.
  A *pushxsave;  // place to restore tstack to
   AFLAGINIT(z,BOX) // Make result inplaceable; recursive too, since otherwise the boxes won't get freed
   // divert the allocation system to use the result area a tstack
   pushxsave = jt->tnextpushp; jt->tnextpushp=AAV(z);  // save tstack info before allocation
- // MUST NOT FAIL UNTIL tstack restored
+ // MUST NOT FAIL UNTIL tstack restored ****************************************************************************************************
  A y;  // y is the newly-allocated block
  // Step through each block: fetch start/end; verify both positive and inrange; calc size of block; alloc and move; make block recursive
  I (*av)[2]=(I (*)[2])voidAV(a);  // pointer to first start/length pair
  I abslength=(I)FAV(self)->localuse.boxcut0.parm;  // 0 for start/length, ~0 for start/end+1
  wr=wr==0?1:wr;   // We use this rank to allocate the boxes - we always create arrays
- A wback=ABACK(w); wback=AFLAG(w)&AFVIRTUAL?wback:w;   // w is the backer for new blocks unless it is itself sirtual
- I i; for(i=0;i<resatoms;++i){
+ A wback=ABACK(w); wback=AFLAG(w)&AFVIRTUAL?wback:w;   // w is the backer for new blocks unless it is itself virtual
+ for(i=0;i<resatoms;++i){
   I start=av[i][0]; I endorlen=av[i][1];
   if(!(BETWEENO(start,0,wi))){jt->tnextpushp=pushxsave; R (FAV(self)->localuse.boxcut0.func)(jtfg,a,w,self);}  // verify start in range - failover if not
   endorlen+=start&abslength;  // convert len to end+1 form
@@ -200,7 +200,7 @@ DF2(jtboxcut0){F12IP;A z;
  // raise the backer for all the virtual blocks taken from it.  The first one requires ra() to force the backer recursive; after that we can just add to the usecount.  And make w noninplaceable, since it now has an alias at large
  if(unlikely((I)jtfg&JTWILLBEOPENED)){I nboxes=jt->tnextpushp-AAV(z); if(likely(nboxes!=0)){ACIPNO(w); ra(wback); ACADD(wback,nboxes-1);}}  // get # boxes allocated without error
  jt->tnextpushp=pushxsave;   // restore tstack pointer
- // OK to fail now - memory is restored
+ // OK to fail now - memory is restored ******************************************************************************************************
  ASSERT(y!=0,EVWSFULL);  // if we broke out on allocation failure, fail.  Since the block is recursive, when it is tpop()d it will recur to delete contents
  // The result can be called pristine if the contents are DIRECT and the result is recursive, because it contains all copied data
  AFLAGORLOCAL(z,(-(t&DIRECT))&(~(I)jtfg<<(AFPRISTINEX-JTWILLBEOPENEDX))&AFPRISTINE)

jsrc/j.h

@@ -1344,8 +1344,22 @@ if(likely(!((I)jtfg&JTWILLBEOPENED)))z=EPILOGNORET(z); RETF(z); \
 // gives errors in some versions #define ALLOBLOCK(n) MAX(PMINL-1,(31-__builtin_clzl((UI4)(n))))    // lg2(#bytes to allocate)-1.  n is #bytes-1
 // value to put into name->bucketx for locale names: number if numeric, hash otherwise
 #define BUCKETXLOC(len,s) ((*(s)<='9')?strtoI10s((len),(s)):(I)nmhash((len),(s)))
-#define ACVCACHECLEAR __atomic_fetch_add(&JT(jt,fnasgnct),1,__ATOMIC_ACQ_REL)  // incr the cache counter for ACVs
-#define ACVCACHEREAD __atomic_load_n(&JT(jt,fnasgnct),__ATOMIC_ACQUIRE)  // read the current cache counter
+// the cache counter/lock is 48 bits of counter and 16 bits of lock (8 bits each read/write).  Write unlock increments the counter
+#if PYXES
+#define ACVCACHEREAD (__atomic_load_n(&JT(jt,fnasgnct),__ATOMIC_ACQUIRE)>>16)  // read the current cache counter
+#define ACVCACHEREADLOCK ({UI prev; if(unlikely(((prev=__atomic_fetch_add(&JT(jt,fnasgnct),1,__ATOMIC_ACQ_REL))&(US)-WLOCKBIT)!=0)){readlock((S*)&JT(jt,fnasgnct),(S)prev); prev=__atomic_load_n(&JT(jt,fnasgnct),__ATOMIC_ACQUIRE);} prev>>16;})
+#define ACVCACHEREADUNLOCK __atomic_fetch_sub(&JT(jt,fnasgnct),1,__ATOMIC_ACQ_REL);  // decrement the read bits
+#define ACVCACHEWRITELOCK  WRITELOCK(*(S*)&JT(jt,fnasgnct))  // take the lock, ignoring data value
+#define ACVCACHECLEAR __atomic_fetch_add(&JT(jt,fnasgnct),0x10000, __ATOMIC_ACQ_REL);  // increment cache count - used when we aren't freeing the only reference to the acv
+#define ACVCACHEWRITEUNLOCK ACVCACHECLEAR __atomic_fetch_and(&JT(jt,fnasgnct),(UI)~(0xffff&-WLOCKBIT), __ATOMIC_ACQ_REL);  // decrement write lock and increment the upper bits
+#else
+#define ACVCACHEREAD JT(jt,fnasgnct)  // read the current cache counter
+#define ACVCACHEREADLOCK ACVCACHEREAD
+#define ACVCACHEREADUNLOCK 
+#define ACVCACHEWRITELOCK 
+#define ACVCACHEWRITEUNLOCK ++JT(jt,fnasgnct);  // increment cache count
+#define ACVCACHECLEAR ++JT(jt,fnasgnct);  // increment cache count - used when we aren't freeing the only reference to the acv
+#endif
 // Support for int-to-float, in parallel.  Input is u, 64-bit int with a type of float; result is 64-bit floats.  Define DECLS first.
 // we use initecho() to initialize zero and one because the compiler moves the initialization to inside the loop
 #define CVTEPI64DECLS  __m256i magic_i_lo = _mm256_castpd_si256(_mm256_broadcast_sd(&two_52)); /* 2^52 */ \

jsrc/ja.h

@@ -347,7 +347,7 @@
 #define extnvr(x)                    jtextnvr(jt,(x))
 #define scaft2(x)
 #if ((MEMAUDIT&5)==5) && SY_64
-#define scaft(x) testbuf(x); if(AN(x)<0)SEGFAULT;
+#define scaft(x) testbuf(x); if(AFLAG(x)<0)SEGFAULT;
 #else
 #define scaft(x) 
 #endif

jsrc/jt.h

@@ -396,14 +396,14 @@ typedef struct JSTstruct {
  C _cl6[0];
  A dbstops;          /* stops set by the user                           */
  A dbtrap;           // trap sentence, execute when going into suspension
- UI4 fnasgnct;        // number of assignments to ACV, change to locale path, etc.  Lookups of ACVs are cached and
-                     // reused as long as one of these cache-invalidating actions has happened.
+ UI fnasgnct;        // number of assignments to ACV, change to locale path, etc.  Lookups of ACVs are cached and
+                     // reused as long as one of these cache-invalidating actions has not happened.  Low 16 bits are a lock
  S dblock;           // lock on dbstops/dbtrap
  // rest of cacheline is essentially read-only
- // 2 bytes free
+ // 6 bytes free
  A evm;              // message text for the EVxxx codes
  I (*emptylocale)[MAXTHREADS][16];      // locale with no symbols, used when not running explicits, or to avoid searching the local syms.  Aligned on odd word boundary, must never be freed.  One per task, because they are modified
- I filler6[3];
+ I filler6[2];
 // end of cacheline 6
 
 // Cacheline 7: startup (scripts and deprecmsgs), essentially read-only

jsrc/jtype.h

@@ -1373,7 +1373,7 @@ typedef struct __attribute__((aligned(CACHELINESIZE))) {I memhdr[AKXR(0)/SZI]; u
 #define FUNCTYPE0 ((A)(validitymask+12))  // 0 0 0 0, which has a 0 in the AT field
 #define FUNCID0 ((A)(validitymask-4*(!SY_64)))  // 0 in index [15] ([19] for 32-bit), which has a 0 in the id field of V
 #define SYMVAL0 ((L*)(validitymask+12))  // 0 0, which has a 0 in the val field of L
-#define AFLAG0 ((A)(validitymask+12))  // 0 0, which has a 0 in the flag field of A
+#define AFLAG0 ((A)(validitymask+12))  // 0 0 0 0, which has a 0 in the flag field and type field of A
 #define ANLEN0 ((A)(validitymask+12-4))  // x x x x 0 0, which has a 0 in the AN field
 #define ZAPLOC0 ((A*)(validitymask+12))  // 0 used as a pointer to a null tpop-stack value
 #define PSTK2NOTFINALASGN ((PSTK*)(validitymask+12)-2)  // 0 in position [2], signifying NOT final assignment (used for errors)