Expunge MEMAUDIT=5; Implement getkv w/0-1 key; don't eformat a sparse arg; don't resignal an error produced by 13!:8

Author: HenryHRich

jsrc/crs.c

@@ -39,7 +39,7 @@ static A jtsprz(J jt,A z0,A y,A e,I f,I*s){A a,a0,q,y0,z;B d;I c,et,h,m,n,r,t,*u
  RZ(z0&&y&&e);
  ASSERT(AN(e),EVDOMAIN);
  if(AN(z0)&&!(AT(z0)&SPARSABLE))R z0;  // no backdoor to sparse boxes.  If non-sparsable type, leave dense
- if(ISSPARSE(AT(e))){ep=PAV(e); ASSERT(all1(eq(SPA(ep,e),SPA(ep,x))),EVSPARSE); q=SPA(ep,e);}
+ if(ISSPARSE(AT(e))){ep=PAV(e); ASSERT(all1(eq(SPA(ep,e),SPA(ep,x))),EVSPARSE); q=SPA(ep,e);}  // 'sparse' sparse element comes from boxing.  If all elements identical, replace with sparse atom
  else{RZ(q=reshape(mtv,e)); ASSERT(all1(eq(q,e)),EVSPARSE);}
  if(!AS(z0)[0]){
   t=AT(q); zt=STYPE(t);
@@ -143,7 +143,7 @@ static A jtsprank2_a0(J jt,A a,A w,A fs,AF f2,I af,I acr){PROLOG(0045);A aa,ae,y
   av+=ak*ac; RE(ak=spradv(an,ab,af,acr,aj,ap,&aa)); aj+=ak;
  }
  RZ(z=ope(z)); AS(z)[0]=am;  // we did one cell of aa to get the shape, but now we have to set back to correct # indexes
- z=sprz(z,zi,CALL2(f2,ae,w,fs),f,as);
+ z=sprz(z,zi,CALL2(f2,ae,w,fs),f,as);  // apply the function to the sparse element
  EPILOG(z);
 }
 

jsrc/d.c

@@ -234,7 +234,7 @@ A jteformat(J jtfg,A self,A a,A w,A m){F12IP;
     A *old=jt->tnextpushp;  // we must free all memory that we allocate here
     if((saverr=str(jt->etxn,jt->etxinfo->etx))!=0){  // save error code and message; if error in str, skip formatting
      A msg=0, m1ah=0, w1ah=0, a1ah=0; // indicate no formatted message; headers for the arguments, which we will delete before exit
-     if(self){
+    if(self){
       if(AT(self)!=0){   // if the self was FUNCTYPE0 eg, a placeholder, don't try to format with it
        // we are going to try to run eformat.
        // we have to reset the state of the error system after saving what we will need
@@ -253,18 +253,19 @@ A jteformat(J jtfg,A self,A a,A w,A m){F12IP;
        // we also have to isolate the user's a/w/m so that we do not disturb any flags or usecounts.  We build headers for the nouns
        // The headers are like virtual blocks but they don't increment the usecount of the backer.  That means that if further execution frees the backer
        // the header is left pointing to garbage.  To avoid trouble we zap the headers here and free them by hand after we call eformat
+       // Since we can't gah() for sparse blocks, we abort eformatting if we encounter one.
        A awm=0;   // place to build the arg list for eformat
-       if(m){A m1; rnk=mtv; if((m1=m1ah=gahzap(jt,AR(m),m))==0)goto noeformat; MCISH(AS(m1),AS(m),AR(m)) if((awm=box(m1))==0)goto noeformat;  // if m exists, make it the last arg, and set rank to ''
+       if(m&&!ISSPARSE(AT(m))){A m1; rnk=mtv; if((m1=m1ah=gahzap(jt,AR(m),m))==0)goto noeformat; MCISH(AS(m1),AS(m),AR(m)) if((awm=box(m1))==0)goto noeformat;  // if m exists, make it the last arg, and set rank to ''
        }else if(e==EVASSEMBLY){
         // assembly errors are special.  They require an info vector, which has been stored in jt->etxinfo.  We pass this vector as m
         if((awm=box(vec(INT,jt->etxinfo->asseminfo.assemframelen+(offsetof(struct assem,assemshape)/sizeof(I)),&jt->etxinfo->asseminfo)))==0)goto noeformat;
        }
        // Convert self to AR.  If self is not a verb convert a/w to AR also
        I selft=AT(self);
        A selfar; if((selfar=arep(self))==0)goto noeformat;
-       if(w&&((selft&CONJ)||(AT(w)&NOUN)))  // if w is valid
+       if(w&&!ISSPARSE(AT(w))&&((selft&CONJ)||(AT(w)&NOUN)))  // if w is valid
          {A w1=w; if(AT(w1)&NOUN){ if((w1=w1ah=gahzap(jt,AR(w),w))==0)goto noeformat; MCISH(AS(w1),AS(w),AR(w)) } if(!(selft&VERB))if((w1=arep(w1))==0)goto noeformat; if((awm=awm?jlink(w1,awm):box(w1))==0)goto noeformat;}
-       if(a){A a1=a; if(AT(a1)&NOUN){if((a1=a1ah=gahzap(jt,AR(a),a))==0)goto noeformat; MCISH(AS(a1),AS(a),AR(a))} if(!(selft&VERB))if((a1=arep(a1))==0)goto noeformat; if((awm=awm?jlink(a1,awm):box(a1))==0)goto noeformat;}
+       if(a&&!ISSPARSE(AT(a))){A a1=a; if(AT(a1)&NOUN){if((a1=a1ah=gahzap(jt,AR(a),a))==0)goto noeformat; MCISH(AS(a1),AS(a),AR(a))} if(!(selft&VERB))if((a1=arep(a1))==0)goto noeformat; if((awm=awm?jlink(a1,awm):box(a1))==0)goto noeformat;}
        // run the analyzer.  Fold the unbalanced-paren info into the error number
        deba(DCJUNK,0,0,0);  // create spacer frame so eformat calls don't overwrite stack
 // obsolete        WITHDEBUGOFF(df1(msg,jlink(sc(e|(pareninfo<<8)),jlink(namestg,jlink(rnk,jlink(selfar,awm)))),val);)  // run eformat_j_

jsrc/j.h

@@ -2292,7 +2292,11 @@ if(unlikely(!_mm256_testz_pd(sgnbit,mantis0))){  /* if mantissa exactly 0, must
  C _e=jt->emsgstate; jt->emsgstate|=EMSGSTATENOTEXT|EMSGSTATENOLINE|EMSGSTATENOEFORMAT|EMSGSTATETRAPPING; \
  stmt jt->uflags.trace=_d|(jt->uflags.trace&~TRACEDB); jt->emsgstate=_e;}  // execute stmt with debug/eformat turned off; restore at end.  Sets jt->jerr if error, and should be used when calling possible user code
 #define WITHDEBUGOFF(stmt) MAYBEWITHDEBUG(0,jt,stmt)
-#define WITHEFORMATDEFERRED(stmt) {WITHDEBUGOFF(stmt) if(unlikely(jt->jerr!=0)){UC _d=jt->jerr; RESETERR ASSERT(0,_d)}}  // execute stmt with debug/eformat turned off; at end, if there is an error, re-signal it
+// obsolete #define WITHEFORMATDEFERRED(stmt) {WITHDEBUGOFF(stmt) if(unlikely(jt->jerr!=0)&&likely(jt->jerr!=0)){UC _d=jt->jerr; RESETERR ASSERT(0,_d)}}  // execute stmt with debug/eformat turned off; at end, if there is an error, re-signal it
+#define WITHEFORMATDEFERRED(stmt) {UC _d=jt->uflags.trace&TRACEDB;jt->uflags.trace&=~TRACEDB; \
+ C _e=jt->emsgstate; jt->emsgstate|=EMSGSTATENOTEXT|EMSGSTATENOLINE|EMSGSTATENOEFORMAT|EMSGSTATETRAPPING; \
+ stmt jt->uflags.trace=_d|(jt->uflags.trace&~TRACEDB); _d=jt->emsgstate; jt->emsgstate=_e; if(unlikely(jt->jerr!=0)&&likely(_d&EMSGSTATENOTEXT)){_d=jt->jerr; RESETERR ASSERT(0,_d)}}  // WITHDEBUGOFF, but resignal any error so as to use caller's eformat.
+        //  Exception: in EMSGSTATENOTEXT was turned off (and not restored), we figure that user used 13!:8, which we don't eformat, so we don't resignal it
 // If the abandoned value we want to ra is likely the last thing on the tstack, look to see if it is.  If so, just back up the tstack (if that backs over to the chain field, that will never match
 // the ZAP pointer and we will not modify tpushnext).  Otherwise ZAP the block
 // It would be a disaster to back the tstack to in front of a valid 'old' pointer held somewhere.  The subsequent tpop would never end.  The case cannot occur, because we set 'old'

jsrc/ja.h

@@ -345,7 +345,7 @@
 #define ext(x,y)                    jtext(jt,(x),(y))
 #define exta(x0,x1,x2,x3)           jtexta(jt,(x0),(x1),(x2),(x3))
 #define extnvr(x)                    jtextnvr(jt,(x))
-#if ((MEMAUDIT&5)==5) && SY_64
+#if 0 && ((MEMAUDIT&5)==5) && SY_64  // obsolete 
 #define scaft(x) testbuf(x); if(AFLAG(x)<0)SEGFAULT;
 #define scaft2(x)
 #endif

jsrc/je.h

@@ -1041,7 +1041,7 @@ extern C        spellin(I,C*);
 extern void     spellit(C,C*);
 extern I        smmallosize(A);
 extern void     smmfrr(A);
-#if ((MEMAUDIT&5)==5) && SY_64 // scaf
+#if 0 && ((MEMAUDIT&5)==5) && SY_64 // scaf obsolete 
 extern void testbuf(A);
 #endif
 extern I        sqrtE(J,I,E*,E*);

jsrc/m.c

@@ -1289,7 +1289,7 @@ __attribute__((noinline)) A jtgafalloos(J jt,I blockx,I n){A z;
  R z;
 }
 
-#if ((MEMAUDIT&5)==5) && SY_64
+#if 0 && ((MEMAUDIT&5)==5) && SY_64   // obsolete
 #define ALLOSIZE (1024*1024)
 static C allohash[ALLOSIZE];  // 0 is empty, 1 is tombstone, 2 is valid
 static C * alloblocks[ALLOSIZE]; static US allolock=0; I nalloblocks=0; I allorunin=0;
@@ -1439,7 +1439,7 @@ if((I)jt&3)SEGFAULT;
 #if SHOWALLALLOC
 printf("%p+\n",z);
 #endif
-#if ((MEMAUDIT&5)==5) && SY_64
+#if 0 && ((MEMAUDIT&5)==5) && SY_64   // obsolete 
 if(JT(jt,peekdata))addbuf(jt,z);  // add to allocated list
 #endif
  R z;
@@ -1628,7 +1628,7 @@ printf("%p-\n",w);
 #if PYXES
   if(unlikely(w->origin!=(US)THREADID1(jt))){jtrepat1(jt,w,allocsize); R;}  // if block was allocated from a different thread, pass it back to that thread where it can be garbage collected
 #endif
-#if ((MEMAUDIT&5)==5) && SY_64
+#if 0 && ((MEMAUDIT&5)==5) && SY_64   // obsolete 
 if(JT(jt,peekdata))rembuf(jt,w);  // remove from allocated list
 #endif
   AFCHAIN(w)=jt->mempool[blockx];  // append free list to the new addition...
@@ -1640,7 +1640,7 @@ if(JT(jt,peekdata))rembuf(jt,w);  // remove from allocated list
   }
  }else if(unlikely(blockx==FHRHBINISGMP)){jtmfgmp(jt,w);  // if GMP allocation, free it through GMP
  }else{    // buffer allocated from malloc
-#if ((MEMAUDIT&5)==5) && SY_64
+#if 0 && ((MEMAUDIT&5)==5) && SY_64   // obsolete
 if(JT(jt,peekdata))rembuf(jt,w);  // remove from allocated list
 #endif
   I allocsize = FHRHSYSSIZE(hrh);

jsrc/vo.c

@@ -453,7 +453,7 @@ static B jtopes2(J jt,A*zx,A*zy,B*b,A a,A e,A q,I wcr){A x;B*c;I dt,k,r,*s,t;P*p
 static A jtopes(J jt,I zt,A cs,A w){A a,d,e,sh,t,*wv,x,x1,y,y1,z;B*b;C*xv;I an,*av,c,dk,dt,*dv,i,j,k,m,m1,n,
      p,*s,*v,wcr,wr,xc,xk,yc,*yv,*zs;P*zp;
  n=AN(w); wr=AR(w); wv=AAV(w); wcr=AN(cs); dt=DTYPE(zt); dk=bpnoun(dt);
- RZ(opes1(&b,&a,&e,&m,cs,w)); an=AN(a); av=AV(a);
+ RZ(opes1(&b,&a,&e,&m,cs,w)); an=AN(a); av=AV(a);  // b=mask of sparse axes; a= I. b (sparse axes); e=sparse element; m=estimate of # nonsparse cells
  GASPARSE0(z,zt,1,wr+wcr); zs=AS(z); MCISH(zs,AS(w),wr); MCISH(zs+wr,AV(cs),wcr);
  zp=PAV(z); c=wcr-an; yc=wr+an;
  SPB(zp,e,cvt(dt,e)); e = SPA(zp,e);  // in case of reassignment by SPB