Work on to-do list

Author: HenryHRich

jsrc/cl.c

@@ -23,7 +23,7 @@ static DF1(jtscfn){F12IP;
 // AM(self) is the block for u
 static DF1(jtlev1){F12IP;
  ARGCHK1(w);  // self is never 0
- if(levelle(jt,w,FAV(self)->localuse.lslevels[2])){A z, fs=(A)AM(self); RZ(z=CALL1(FAV(fs)->valencefns[0],w,fs)); if(FAV(self)->id!=CSCAPCO)RETF(z); R scfn(z,self);} else{STACKCHKOFL R every(w,self);}  // since this recurs, check stack  scaf if abandoned inplaceable, could have a version of every that replaces boxes in place
+ if(levelle(jt,w,FAV(self)->localuse.lslevels[2])){A z, fs=(A)AM(self); RZ(z=CALL1(FAV(fs)->valencefns[0],w,fs)); if(FAV(self)->id!=CSCAPCO)RETF(z); R scfn(z,self);} else{STACKCHKOFL R every(w,self);}  // since this recurs, check stack
 }
 
 // Like monad, but AT(self) is left trigger level, AC(self) is the right trigger level 

jsrc/m.c

@@ -1148,17 +1148,14 @@ void freetstackallo(J jt){
  jt->tstackcurr=(A*)jt->tstackcurr[0];   // back up to the previous block
 }
 
-// measureI tpopscaf[10];  // # tpops requested
 // pop stack,  ending when we have freed the entry with tnextpushp==old.  tnextpushp is left pointing to an empty slot
 // If the block has recursive usecount, decrement usecount in children if we free it
-// stats I totalpops=0, nonnullpops=0, frees=0;
 void jttpop(J jt,A *old,A *pushp){A *endingtpushp;
  // pushp points to an empty cell.  old points to the last cell to be freed.  decrement pushp to point to the cell to free (or to the chain).  decr old to match
  // if jttg failed to allocate a new block, we will have left pushp pointing to the cell after the last valid cell.  This may be in unmapped memory, but
  // that's OK, because we start by decrementing it to point to the last valid push
  // errors that could not be eformatted at once might do tpop on the way out.  We ignore these if there is a pmstack.
  if(unlikely(jt->pmstacktop!=0))R;
-// measure if(EXPLICITRUNNING){I scafn=pushp-old; scafn=(UI)scafn>9?9:scafn; ++tpopscaf[scafn];}  // histo the stack size
  jt->tnextpushp = old;  // when we finish, this will be the new start point.  Set it early so we don't audit things in the middle of popping
  --pushp; --old;
  while(1) {A np;  // loop till end.  Return is at bottom of loop
@@ -1173,9 +1170,7 @@ void jttpop(J jt,A *old,A *pushp){A *endingtpushp;
    // It is OK to prefetch the next box even on the last pass, because the next pointer IS a pointer to a valid box, or a chain pointer
    // to the previous free block (or 0 at end), all of which is OK to read and then prefetch from
    np0=*pushp;   // point to block for next pass through loop
-// stats totalpops++;
    if(np){
-// stats nonnullpops++;
     I c=AC(np);  // fetch usecount.
     // We never tpush a PERMANENT block, but a block can become PERMANENT during the run, so we have to check
     if(likely(!ACISPERM(c))){     // if block not PERMANENT...
@@ -1184,7 +1179,6 @@ void jttpop(J jt,A *old,A *pushp){A *endingtpushp;
      // If count goes to 0: if the usercount is marked recursive, do the recursive fa(), otherwise just free using mf().  If virtual, the backer must be recursive, so fa() it
      // Otherwise just decrement the count
      if(c<=1||ACDECRNOPERM(np)<=1){  // avoid RFO if count is 1
-// stats ++frees;
       // The block is going to be destroyed.  See if there are further ramifications
       if(!(flg&AFVIRTUAL)){fanapop(np,flg);}   // do the recursive POP only if RECURSIBLE block; then free np
       else{A b=ABACK(np); fanano0(b); mf(np);}  // if virtual block going away, reduce usecount in backer, ignore the flagged recursiveness just free the virt block
@@ -1409,7 +1403,6 @@ A zfillind(A w, I m){
  }
  R w;
 }
-// stats I statsnga=0, statsngashape=0;
 // like jtga, but don't copy shape.   Never called for SPARSE type
 // We pack rank+type into one reg to save registers (it also helps the LIMIT test).  With this, the compiler should be able to save/restore
 // only 2 regs (ranktype and bytes) but the prodigal compiler saves 3.  We accept this to be able to save AK AR AT here, so that the caller doesn't have to preserve them over the call.
@@ -1425,7 +1418,6 @@ RESTRICTF A jtga0(J jt,I ranktype,I atoms){A z;
  // Clear data for non-DIRECT types in case of error
  // Since we allocate powers of 2, we can make the memset a multiple of 32 bytes.
  if(unlikely(!(((I4)ranktype&DIRECT)>0))){z=zfillind(z,bytes);}  // unlikely is important!  compiler strains then to use one less temp reg
-// stats  ++statsnga; statsngashape+=shaape!=0;
  R z;
 }
 #else

jsrc/va2.c

@@ -1829,7 +1829,7 @@ VA2 jtvar(J jt,A self,I at,I wt){I t;
    // B I D Z  X  Q Symb DS  E I2 I4 
    pri=4+((0x5affcbf476ffffffLL>>(pri<<2))&0xf);  // 4 is II, lower than the lowest routine# we can call for here
    VA2 selva2 = vainfo->p2[pri];  // routine/flags for the top-priority arg
-   I cvtflgs=(apri>wpri?VCOPYA:0)+(apri<wpri?VCOPYW:0);  // set the flag to cause conversion of low-pri arg to the upper.  This handles ALL mixed-mode conversions  scaf would be nice to avoid conversion of left arg of o.
+   I cvtflgs=(apri>wpri?VCOPYA:0)+(apri<wpri?VCOPYW:0);  // set the flag to cause conversion of low-pri arg to the upper.  This handles ALL mixed-mode conversions
    cvtflgs=selva2.cv&(VBB|VII|VDD|VZZ)?0:cvtflgs;  //  If the routine already forces a conversion, don't override.  Most DD, SP, QP specify no conversion, but +. or bitwise require bool or integer 
    selva2.cv|=cvtflgs;
    R selva2;

jsrc/vcat.c

@@ -294,7 +294,7 @@ DF2(jtover){F12IP;AD * RESTRICT z;I replct,framect,acr,ar,ma,mw,p,q,t,wcr,wr,zn;
  q=AS(w)[wr-1];   //  q=len of last axis of cell
  if(((MAX(acr,wcr)-3)&-AN(a)&-AN(w)&((acr+wcr-3)|((p^q)-1)))<0){  // r<=2, neither arg empty,  (sum of ranks<3 (if max rank <= 2 and sum of ranks >2, neither can possibly be an atom) OR items (which are lists) have same length)
   // joining atoms, rows, row/atom, or table/row with same lengths, or table/atom; possibly with frame.  In any case no fill is possible, but scalar replication might be
-  // scaf this could be generalized to any time ranks differ by at most 1 and the items agree or one is atomic
+  // this could be generalized to any time (ranks differ by at most 1 and the items agree) or (one is atomic); no fill needed then.  But it complicates the computation too much, because p/q need to become pairs, and registers are dear.  The high-rank case is rare.
   I awcrflg=4*acr+wcr;  // incredible register pressure.  Combine af/wf, and shift in flags as we calculate them
   I cc2a=__atomic_load_n(&AS(a)[ar-2],__ATOMIC_RELAXED); p=awcrflg&0b1100?p:1; cc2a=awcrflg&0b1000?cc2a:1; ma=cc2a*p; ma=awcrflg==0b0010?q:ma;  //   cc2a is # 2-cells of a; ma is #atoms in a cell of a EXCEPT when joining atom a to table w: then length of row of w; i. e. #atoms to fill from an item of a
   I cc2w=__atomic_load_n(&AS(w)[wr-2],__ATOMIC_RELAXED); q=awcrflg&0b0011?q:1; cc2w=awcrflg&0b0010?cc2w:1; cc2a+=cc2w; mw=cc2w*q; mw=awcrflg==0b1000?p:mw;  // sim for w; cc2a is combined length of axis -2 f can increment only once

jsrc/xdic.c

@@ -1087,8 +1087,7 @@ static A dumptree(J jt,DIC *dic, UI nodex, C *dirstack, I depth, I blackdepth, I
  A k,v; RZ(k=from(sc(RENCEMPTY(nodex)),dic->bloc.keys)) RZ(v=from(sc(RENCEMPTY(nodex)),dic->bloc.vals))  // fetch current key/val
  A klr, vlr; RZ(klr=lrep(k)) RZ(vlr=lrep(v))  // displayable form of k,v
  if(doprint)printf("%.*s: node=0x%x key=%.*s val=%.*s c=%d l=0x%x r=0x%x",(int)depth,dirstack,(int)nodex,(int)AN(klr),CAV(klr),(int)AN(vlr),CAV(vlr),(int)currc,(int)currl,(int)currr);
- if(prevkey&&IAV(jttao(jt,prevkey,k))[0]>=0)
-{jttao(jt,prevkey,k);  /* scaf */if(doprint)printf(" key vio"); *noerr=0;}
+ if(prevkey&&IAV(jttao(jt,prevkey,k))[0]>=0){if(doprint)printf(" key vio"); *noerr=0;}
 // obsolete  if(currc==1&&((currr|currl)&~1)==0){if(*leafblackdepth>=0&&*leafblackdepth!=blackdepth){if(doprint)printf(" black vio"); *noerr=0;} *leafblackdepth=blackdepth;}  // black & leaf, check depth
  if(((parentcolor|currc)&1)==0){if(doprint)printf(" red vio"); *noerr=0;}
  if(doprint)printf("\n");
@@ -1109,7 +1108,7 @@ static I auditnode(J jt,DIC *dic,UI nodex,UI excludednode, I doprint){A z;
 // Result is 1 if OK, 0 if error
 DF2(jtdisprbdic){F12IP;
  ARGCHK1(w)
- if(!(((DIC*)w)->bloc.flags&DICFRB)){printf("not a tree dict\n"); R -1;}
+ ASSERTSYS(((DIC*)w)->bloc.flags&DICFRB,"not a tree dic")
  A na=w==self?zeroionei(1):a; w=w==self?a:w; I opts; RE(opts=b0(na));   // get print options
  R sc(auditnode(jt,(DIC*)w,*(UI4AV3(((DIC*)w)->bloc.hash))&_bzhi_u64(~(UI8)1,((DIC*)w)->bloc.hashelesiz<<LGBB),~0LL,opts));
 }