purge obsolete code; 13!:24; better test for displaying name in emsg

jsrc/cx.c

@@ -442,9 +442,7 @@ nextlinedebug:;
    }else if(unlikely((jt->jerr&(EVEXIT^EVDEBUGEND))==EVEXIT)){ic=OBCW; goto nextlinetcesx;  // if 2!:55 requested, honor it regardless of debug status; also EVDEBUGEND which silently cuts everything back in that thread
    }else if(unlikely((NPGpysfmtdl&16)&&(jt->uflags.trace&TRACEDB1))){  // if we get an error return from debug, the user must be branching to a new line.  Check for it
     if(jt->jerr==EVCUTSTACK)BZ(0);  // if Cut Stack executed on this line, abort the current definition, leaving the Cut Stack error to cause caller to flush the active sentence
-// obsolete     z=mtm,
     bic=ic;goto nextlinedebug;   // Remember the line w/error; fetch continuation line#. it is OK to have jerr set if we are in debug mode.  We must go through debug to clear z
-// obsolete ,ic=~debugnewi(~ic+1,jt->sitop,self)
    }else if(unlikely(jt->jerr==EVTHROW)){
     // if the error is THROW, and there is a catcht. block, go there, otherwise pass the THROW up the line
     if(NPGpysfmtdl&4){I j; for(j=CWGO(cwsent,CNSTOREDCW,tdv[-1].b);!TEQ5(CWTCESX(cwsent,j),CEND)&&!TEQ6(CWTCESX(cwsent,j),CBBLOCKEND);j=CWGO(cwsent,CNSTOREDCW,j))if(TEQ5(CWTCESX(cwsent,j),CCATCHT)){ic=j-1; RESETERR; z=mtm; POPIFTRYSTK break;}} BASSERT(z!=0,EVTHROW);  // z might not be protected if we hit error
@@ -483,9 +481,7 @@ nextlinedebug:;
     if(unlikely((jt->jerr&(EVEXIT^EVDEBUGEND))==EVEXIT)){ic=OBCW; goto nextlinetcesx;  // if 2!:55 requested, honor it regardless of debug status; also EVDEBUGEND which silently cuts everything back in that thread
     }else if(unlikely((NPGpysfmtdl&16)&&(jt->uflags.trace&TRACEDB1))){  // if we get an error return from debug, the user must be branching to a new line.  Do it
      if(jt->jerr==EVCUTSTACK)BZ(0);  // if Cut Stack executed on this line, abort the current definition, leaving the Cut Stack error to cause caller to flush the active sentence
-// obsolete      z=mtm,
      bic=ic;goto nextlinedebug;   // Remember the line w/error; fetch continuation line#. it is OK to have jerr set if we are in debug mode.  Must go through nextline to set z non0
-// obsolete ,ic=~debugnewi(~ic,jt->sitop,self)
     }else if(unlikely(EVTHROW==jt->jerr)){if(NPGpysfmtdl&4){I j; for(j=CWGO(cwsent,CNSTOREDCW,tdv[-1].b);!TEQ5(CWTCESX(cwsent,j),CEND)&&!TEQ6(CWTCESX(cwsent,j),CBBLOCKEND);j=CWGO(cwsent,CNSTOREDCW,j))if(TEQ5(CWTCESX(cwsent,j),CCATCHT)){ic=j-1; RESETERR; z=mtm; POPIFTRYSTK break;}} BASSERT(z!=0,EVTHROW);  // if throw., and there is a catch., do so
     }else{bic=ic; ic=CWGO(cwsent,CNSTOREDCW,ic); IFNOTOB(){RESETERR; z=mtm; cv=forpopgoto(jt,cv,ic,1); POPIFTRYSTK}else z=0;}  // nondebug error: if we take error exit, we might not have protected z, which is not needed anyway; so clear it to prevent invalid use.  Pop try. stack always, for. stack if needed
       // if we are not taking the error exit, we still need to set z to a safe value since we might not have protected it.

jsrc/d.c

@@ -320,13 +320,14 @@ A jtjsignale(J jt,I eflg,A line,I info){
      // start with terse message [: name]
      A msg=eflg&EMSGLINEISTERSE?line:AAV(JT(jt,evm))[e];  // jsignal/jsignal3/13!:8 dyad.  Use the terse string except for 13!:8
      jteputlnolf(jt,msg);  // header of first line: terse string
-     // decide what name, if any, to show.  By default, the name of the executing entity
-     A nameblok=jt->curname;
-     // If there is a debug stack, we look for the topmost CALL.  If this is from a non-pm explicit entity, it will be followed by a PARSE entry.
-     // If the PARSE (or the CALL if there is no parse) is NOT suspended, show the name (it must be the first time, and the suspension hans't been set yet).  If suspended, it's an error during suspension, suppress the name
+     // Decide what name, if any, to show.  By default, the name of the executing entity, but if no name has started after the last suspension,
+     // it means the user has typed a failing sentence like (1 + 'a') into suspension: it is not part of the suspended name and should not be so decorated.
+     // If there is no suspension, we type the name, but this is trickier than it appears: during superdebug we may turn off debug while a SCRIPT type is
+     // supplying the sentence lines, and that script will keep running, preventing the clear-suspension message from being passed up the line to clear
+     // the debug stack.  
+     DC d; for(d=jt->sitop;d;d=d->dclnk){if(d->dctype==DCSCRIPT)break; if(d->dcsusp)break; if(d->dctype==DCCALL)break; }  // stop on EOC, SCRIPT/CALL, or suspension
+     A nameblok=(d&&d->dctype!=DCSCRIPT&&!d->dcsusp)?0:jt->curname;  // use name unless we reached suspension without seeing a CALL
      // Value error, which may come up after the stack is long gone, set EMSGLINEISNAME to override the name
-     DC d,expd=0; NOUNROLL for(d=jt->sitop;d&&DCCALL!=d->dctype;d=d->dclnk){expd=d;}  // find topmost call, e=following ele if any (always set if not tacit/pm)
-     d=d&&d->dcc&&d->dcpflags==0?expd:d; if(d&&d->dcsusp)nameblok=0;  // if non-pm explicit, look for dcsusp in explicit block.  If suspension already set,  don't show the old name again
      nameblok=eflg&EMSGLINEISNAME?line:nameblok;  // if caller overrides the name, use the caller's name
      if(nameblok){if(!jt->glock){eputs(": "); ep(AN(nameblok),NAV(nameblok)->s);}}  // ...followed by name of running entity
      if(eflg&EMSGFROMPYX)eputs(" (from pyx)");   // if the message came from a pyx, mark it as such

jsrc/dsusp.c

@@ -97,14 +97,29 @@ I lnumsi(DC d){A c;I i;
 
 }    /* source line number from DCCALL-type stack entry */
 
-
+// set suspension flag on the most recent execution.  Called before going into suspension, and always with debug turned on.
+// The flag is set in the most recent PARSE frame, if any; if the most recent thing is a tacit CALL, use that.  If the most
+// recent frame is explicit CALL (no PARSE), that's weird: xdefn must have died aborning, do nothing
 static DC suspset(DC d){DC e=0;
- NOUNROLL while(d&&DCCALL!=d->dctype){e=d; d=d->dclnk;}  // find topmost call, e=previous ele
- if(!(d&&DCCALL==d->dctype))R 0;                /* don't suspend if no such call     */
+ NOUNROLL while(d&&d->dctype!=DCCALL){if(!e&&d->dctype==DCPARSE)e=d; d=d->dclnk;}  // find topmost call, e=first PARSE
+ if(!d)R 0;                /* don't suspend if no such call     */
  if(d->dcc){RZQ(e); e->dcsusp=1;}               // if explicit, set susp on line - there should always be a following frame, but if not do nothing
  else      d->dcsusp=1;                         /* if not explicit, set susp on call */
  R d;
-}    /* find topmost call and set suspension flag */
+}
+
+// 13!:24 Isolate the current suspension on the stack.  Valid only when debug on.
+// we find the CALL for the w-most suspended frame, and set suspension in the PREVIOUS stack frame, thus cutting off
+// any stack frames before the one that triggered suspension
+// Result is i.0
+F1(jtdbisolatestk){
+ ASSERT(jt->uflags.trace&TRACEDB1,EVNONCE);  // debug must be on
+ I n; RZ(n=i0(w)); ASSERT(n>0,EVDOMAIN);  // get # lines to isolate, audit positive
+ DC d; while(d&&!d->dcsusp)d=d->dclnk; // d->end of topmost suspension
+ for(;d&&n;d=d->dclnk)n-=d->dctype==DCCALL;  // d->stack frame before the nth call
+ if(d)d->dcsusp=1;  // install suspension
+ R mtv;
+}
 
 static B jterrcap(J jt){A y,*yv;
  GAT0(y,BOX,4,1); yv=AAV(y);
@@ -229,22 +244,6 @@ static A jtdebug(J jt){A z=0;C e;DC c,d;
    }
   }
   break;
-// obsolete   I msgowed=0, nsusp=0;  // will be set if we have to tell the user about interrupted scripts; suspension level (# suspensions above c)
-// obsolete   NOUNROLL for(c=jt->sitop;c;c=c->dclnk){  // go through the stack...
-// obsolete    nsusp+=c->dcsusp;   // update susp level for the marked frame, stopping before the next marked frame
-// obsolete    switch(c->dctype){
-// obsolete    case DCCALL: DGOTO(c,-1) c->dcsusp=0; break; // turn off all suspensions and force every explicit definition to its exit line; track suspension level
-// obsolete    case DCSCRIPT:   // check running scripts
-// obsolete     if(c->dcss){   // if script is reading from file/string (should always be set)
-// obsolete      if(jt->uflags.trace&TRACEDB1){msgowed=1;  // dbr 1: allow all scripts to continue, with one msg
-// obsolete      }else if(nsusp<2){c->dcix=-1; msgowed=1;  // dbr 0: turn off scripts in first suspension (we will give one message per suspension)
-// obsolete      }
-// obsolete     }
-// obsolete      break;
-// obsolete    }
-// obsolete   }
-// obsolete   if(msgowed)jsto(JJTOJ(jt),MTYOER,jt->uflags.trace&TRACEDB1?"Interrupted script load resumes\n":"Interrupted script load aborted\n");
-// obsolete   break;   // exit from all functions, clearing suspensions; back to immed mode with clear debug stack
  case SUSNEXT:  // continue execution on next line
  case SUSSS:  // single-step continuation
   z=mtm; break;  // pick up wherever it left off; no result
@@ -374,8 +373,6 @@ F1(jtdbc){I k;
  DONOUNROLL(NALLTHREADS(jt), if(k&1)__atomic_fetch_or(&jjbase[i].uflags.trace,TRACEDB1,__ATOMIC_ACQ_REL);else __atomic_fetch_and(&jjbase[i].uflags.trace,~TRACEDB1,__ATOMIC_ACQ_REL);) JT(jt,dbuser)=k;
  jt->cstackmin=jt->cstackinit-((CSTACKSIZE-CSTACKRESERVE)>>(k&TRACEDB1));  // if we are setting debugging on, shorten the C stack to allow suspension commands room to run
  if(likely(!(k&TRACEDBDEBUGENTRY)))JT(jt,dbuser)|=TRACEDBSUSCLEAR;  // come out of suspension, whether 0 or 1.  If going into pm debug, suppress this so we don't immediately come out of debug
- suspset(jt->sitop);   // If we aren't in suspension, there might be a debug stack, perhaps from Dissect or a Lab that is about to debug something.  In that case, we mark the current top of stack as suspended
-                       // to prevent Cut Back commands from overstepping the sentence being debugged.  We do this willy-nilly since if we are in suspension the stack is about to be cleared anyway
  A z; RZ(z=ca(mtm)); AFLAGORLOCAL(z,AFDEBUGRESULT) R z;
 }    /* 13!:0  clear stack; enable/disable suspension */
 

jsrc/je.h

@@ -460,6 +460,7 @@ extern F2(jtdbstepinto2);
 extern F2(jtdbstepout2);
 extern F2(jtdbstepover2);
 extern F2(jtdbpasss);
+extern F1(jtdbisolatestk);
 extern DF2(jtdeal);
 extern DF2(jtdealx);
 extern F2(jtdex);

jsrc/jtype.h

@@ -493,7 +493,6 @@ struct AD {
 #define ASGNTONAME      ((I)1L<<CONWX)     // set when assignment is to name    aliases with CONW
 // NOTE: The parser assumes that CONW always means ASGNTONAME, so don't use it in any parseable type except ASGN
 // ** NOUN types can have the following informational bits set
-// obsolete #define NOUNCVTVALIDCT  ((I)1L<<SYMBX)     // Flag for jtcvt arg only: if set, convert only the #atoms given in the parameter   Aliases with SYMB
 #define SPARSEX 31  // NOTE this extends to the sign bit
 #if defined(_WIN64)||defined(__LP64__)
 #define SPARSE            (-((I)1L<<SPARSEX))       /* P  sparse boxed                 */

jsrc/k.c

@@ -827,9 +827,7 @@ A jtccvt(J jt,I tflagged,A w,I natoms){A d,z;I n,r,*s,wt; void *wv,*yv;I t=tflag
  if(unlikely(t&CMPX+QP))AK(d)=(AK(d)+SZD)&~SZD;  // move 16-byte values to 16-byte bdy
  yv=voidAV(d);   // address of target area
 
-// obsolete  if(unlikely(tflagged&NOUNCVTVALIDCT)){
  if(unlikely(natoms!=0)){
-// obsolete   I inputn=natoms;  // fetch input, in case it is called for
   if(natoms>0){  // if converting the leading values, just update the counts
    n=natoms-1;  // set the counts for local use, and in the block to be converted
   }else{  // if converting trailing values (natoms is 1s comp of # trailing values)...
@@ -964,7 +962,6 @@ A jtcvt(J jt,I t,A w){
  A z=ccvt(t,w,0);  // attempt the conversion, set error if any
  if(unlikely(0==z)) { // used to be x:_ could be XNUM, now must be RAT
   if(jt->jerr==EWIRR) {RESETERR; z=ccvt(RAT,w,0);}  // retry if soft failure
-// obsolete   ASSERT(z!=0,EVDOMAIN);
  }
  R z;
 }
@@ -1002,10 +999,6 @@ A jtbcvt(J jt,C mode,A w){FPREFIP(J); A z=w;
  if(mode&1||!(AT(w)&XNUM+RAT)){  // if we are not stopping at XNUM/RAT
   // To avoid a needless copy, suppress conversion to B01 if type is B01, to INT if type is INT, etc
   // set the NOFUZZ flag in t to insist on an exact match so we won't lose precision
-// obsolete   jtinplace=(J)((I)jt+JTNOFUZZ);  // demand exact match
-// obsolete   z=!(mode&14)&&jtccvt(jtinplace,B01,w,&y)?y:
-// obsolete     (y=w,ISDENSETYPE(AT(w),INT)||(!(mode&12)&&jtccvt(jtinplace,INT,w,&y)))?y:
-// obsolete     (y=w,ISDENSETYPE(AT(w),FL)||(!(mode&8)&&jtccvt(jtinplace,FL,w,&y)))?y:w;  // convert to enabled modes one by one, stopping when one works
   if(!(mode&14)&&(z=jtccvt(jtinplace,B01|CVTNOFUZZ,w,0)));  // if OK to try B01, and it fits, keep B01
   else if(ISDENSETYPE(AT(w),INT))z=w;   // if w is INT, we can't improve
   else if(!(mode&12)&&(z=jtccvt(jtinplace,INT|CVTNOFUZZ,w,0)));  //  OK to try INT and it fits, keep B01

jsrc/result.h

@@ -144,7 +144,6 @@ do{
 #else
        zatomct=(((zzcellp+zzcelllen)>>zzatomshift)-AN(zz))-1;   // get 1s comp of # atoms that have been filled in, not including what we haven't filled yet in this cell (neg indicates trailing items)
 #endif
-// obsolete        RZ(ccvt(zt|NOUNCVTVALIDCT,zz,(A*)&zatomct)); zz=(A)zatomct;  // flag means convert only # atoms given in zatomct
        RZ(zz=ccvt(zt,zz,zatomct));  // flag means convert only # atoms given in zatomct
        // change the strides to match the new cellsize
        if(zexpshift>=0){zzcelllen<<=zexpshift; zzcellp<<=zexpshift;}else{zzcelllen>>=-zexpshift; zzcellp>>=-zexpshift;}

jsrc/va2.c

@@ -466,8 +466,6 @@ static A jtva2(J jt,AD * RESTRICT a,AD * RESTRICT w,AD * RESTRICT self,UI allran
   if(likely(!(((I)jtinplace&JTRETRY)+((at|wt)&((SPARSE|NOUN)&~(B01|INT|FL)))))){  // no error, bool/int/fl nonsparse args
    // Here for the fast and important case, where the arguments are both dense B01/INT/FL
    VA *vainfo=((VA*)((I)va+FAV(self)->localuse.lu1.uavandx[1]));  // extract table line from the primitive
-// obsolete    // The index into va is atype*3 + wtype, calculated sneakily.  We
-// obsolete    aadocv=&vainfo->p2[(at>>(INTX-1))+((at+wt)>>INTX)];
    aadocv=&vainfo->p2[(at*3+(wt&INT+FL))>>INTX];   // test here to avoid the call overhead
   }else{
 
@@ -629,9 +627,6 @@ static A jtva2(J jt,AD * RESTRICT a,AD * RESTRICT w,AD * RESTRICT self,UI allran
      n=(n*nf)^REPSGN(SGNIF(jtinplace,VIPWFLONGX)&(1-nf)); m*=migrmf;   // propagate mf and nf down; if n is not 1, complement if af<wf
      mf=1;  // no outer loops.  nf immaterial.  zk does not need to change since it will not be used
     }else{--nf;}   // All 4 loops (normal case since rank given).nf is outer loop repeat count-1
-// obsolete      DPMULDE(nf,mf,mf);
-// obsolete      DPMULDE(zn,mf,zn)  // total # atoms in result
-// obsolete     }
    }else{  // sparse case
     I af=acr>>(RANKTX), wf=wcr>>(RANKTX); acr&=RANKTMSK; wcr&=RANKTMSK;   // separate cr and f for sparse
     fr=acr<wcr?wcr:acr; I f=(af<wf)?wf:af; fr+=(f<<RANKTX)+f; aawwzk[0]=acr; aawwzk[1]=wcr; mf=af; nf=wf;
@@ -1343,8 +1338,6 @@ VA2 jtvar(J jt,A self,I at,I wt){I t;
   VA *vainfo=((VA*)((I)va+FAV(self)->localuse.lu1.uavandx[1]));  // extract table line from the primitive
   if(!((t=(at|wt))&(NOUN&~(B01|INT|FL)))){
    // Here for the fast and important case, where the arguments are both B01/INT/FL
-// obsolete    // The index into va is atype*3 + wtype, calculated sneakily
-// obsolete    R vainfo->p2[(at>>(INTX-1))+((at+wt)>>INTX)];
    R vainfo->p2[(at*3+(wt&INT+FL))>>INTX];
 
   }else if(likely(!(t&(NOUN&~NUMERIC)))) {

jsrc/vo.c

@@ -276,7 +276,6 @@ A jtassembleresults(J jt, I ZZFLAGWORD, A zz, A zzbox, A* zzboxp, I zzcellp, I z
   if(TYPESNE(zft,zzt)){I zzatomshift=CTTZ(bpnoun(zzt)); I zexpshift = CTTZ(bpnoun(zft))-zzatomshift;  // shift for size of atom; expansion factor of the conversion, as shift amount
    // here the old values in zz must change.  Convert them.  Tell cvt tp converts only as many atoms as given
    I zatomct=(zzcellp>>zzatomshift)-(startatend&(AN(zz)-(zzcelllen>>zzatomshift)))+1;   // get # atoms that have been filled in, offset by 1
-// obsolete    ASSERT(ccvt(zft|NOUNCVTVALIDCT,zz,(A*)&zatomct),EVDOMAIN); zz=(A)zatomct;  // flag means convert zcellct atoms.  Not worth checking for empty
    ASSERT(zz=ccvt(zft,zz,zatomct),EVDOMAIN);  // flag means convert zcellct atoms.  Not worth checking for empty
    // change the strides to match the new cellsize
    if(likely(zexpshift>=0)){zzcelllen<<=zexpshift; zzcellp<<=zexpshift;}else{zzcelllen>>=-zexpshift; zzcellp>>=-zexpshift;}

jsrc/x.c

@@ -311,6 +311,7 @@ void jtforeigninit(J jt){UI i;
  MN(13,21) XPRIM(VERB, jtdbstepinto1,jtdbstepinto2,VFLAGNONE,VF2NONE,RMAX,RMAX,RMAX);
  MN(13,22) XPRIM(VERB, jtdbstepout1, jtdbstepout2, VFLAGNONE,VF2NONE,RMAX,RMAX,RMAX);
  MN(13,23) XPRIM(VERB, jtdbpasss, jtdbpasss, VFLAGNONE,VF2NONE,RMAX,RMAX,RMAX);
+ MN(13,24) XPRIM(VERB, jtdbisolatestk, 0,           VFLAGNONE,VF2NONE,RMAX,RMAX,RMAX);
  MN(15,5)  XPRIM(VERB, jtcdf,        0,            VASGSAFE,VF2NONE,RMAX,RMAX,RMAX);
  MN(15,7)  XPRIM(VERB, jtdllsymset,  0,            VASGSAFE,VF2NONE,RMAX,RMAX,RMAX);   
  MN(15,8)  XPRIM(VERB, jtgh15,       0,            VASGSAFE,VF2NONE,RMAX,RMAX,RMAX);

test/g13x.ijs

@@ -449,7 +449,7 @@ NB. ------------ eformat ---------------------------------------------------
 
 1 e. '(0)' E. 4 {{y*"(0) 0 0 1,:_ _,7)];.0 x}} eftx 5 6 7  NB. verify error disp puts () around PPPP noun
 
-f =: 1:`(-: ". eftx)@.(3 = 4!:0 <'eformat_j_')  NB. check verbose msgs only if defined
+f =: 1:`(-:   ". eftx)@.(3 = 4!:0 <'eformat_j_')  NB. check verbose msgs only if defined
 
 '|length error in f, executing dyad +|shapes 2 and 3 do not conform|   2 3    +4 5 6'    f '2 3+4 5 6'
 '|length error in f, executing dyad +"1|shapes 2 3 and 4 5 6 do not conform|   (i.2 3)    +"1 i.4 5 6'    f '(i. 2 3)+"1 i.4 5 6'