diff --git a/jsrc/p.c b/jsrc/p.c index 2c920411e..a5dcde158 100644 --- a/jsrc/p.c +++ b/jsrc/p.c @@ -578,16 +578,20 @@ A jtparsea(J jt, A *queue, I nwds){F1PREFIP;PSTK *stack;A z,*v; pt0ecam&=~(NAMEBYVALUE+NAMEABANDON)>>(NAMEBYVALUEX-NAMEFLAGSX); // install name-status flags from y pt0ecam|=((I)y&(QCNAMEABANDON+QCNAMEBYVALUE))<fval)==0))goto rdglob; // if value has not been assigned, ignore it. y has QCSYMVAL semantics // obsolete y=(A)((I)s->val+s->valtype); // combine the type and value. type has QCSYMVAL semantics, as y does. if(unlikely(ISRAREQD(y=s->fval)))raposlocalqcgsv(QCWORD(y),QCPTYPE(y),y); // ra the block if needed - rare for locals (only sparse). Now we call it QCFAOWED semantics - }else if(likely((buck=NAV(QCWORD(y))->bucket)>0)){ // buckets but no symbol - must be global, or recursive symtab - but not synthetic new name + }else if(likely((buck=NAV(QCWORD(y))->bucket)>0)){ // buckets but no symbol - must be global, or recursive symtab - but not synthetic new name. We would fetch symx&buck together if we could hand-code it. + // public names come through here (with positive pucketx) or I bx=NAVV(y)->bucketx; // get an early fetch in case we don't have a symbol but we do have buckets - globals, mainly if(likely((bx|(I)(I1)AR(jt->locsyms))>=0))goto rdglob; // if positive bucketx and no name has been added, skip the search - the usual case if not recursive symtab - // negative bucket (indicating exactly where the name is) or some name has been added to this symtab. We have to probe the local table - if((y=probelocalbuckets(sympv,y,LXAV0(jt->locsyms)[buck],bx))==0){y=QCWORD(*(volatile A*)queue);goto rdglob;} // see if there is a local symbol, using the buckets. If not, restore y + // negative bucket (indicating exactly where the name is) or some name has been added to this symtab. We have to probe the local table. Added name is pretty rare - + // should we loop through the buckets on a local name? Probably - saves a call for every name in a non-primary table + if(likely(bx<0)){L* l; for(l=LXAV0(jt->locsyms)[buck]+sympv;++bx<0;l=l->next+sympv); y=l->fval;} // local name in cloned table. Get to it without subroutine call + else if((y=probelocalbuckets(sympv,y,LXAV0(jt->locsyms)[buck],bx))==0){y=QCWORD(*(volatile A*)queue);goto rdglob;} // must be unassigned name and there has been a surprise write to the cloned symtab. Rare indeed. If not found, it's global - restore y if(unlikely(ISRAREQD(y)))raposlocalqcgsv(QCWORD(y),QCPTYPE(y),y); // ra the block if needed - rare for locals (only sparse). Now we call it QCFAOWED semantics }else{ // No bucket info. Usually this is a locative/global, but it could be an explicit modifier, console level, or ". @@ -647,7 +651,7 @@ rdglob: ; // here when we tried the buckets and failed // obsolete y=SETFAOWED(y); }else{ // not a noun/nonlocative-nameless-modifier. We have to stack a reference to the ACV. But if the value IS a reference, use the value if possible to avoid the extra lookup A origname=QCWORD(*(volatile A*)queue); // refetch the name -#if 0 // obsolete? parhaps too far +#if 0 // obsolete if it's to be done, it should be in unquote if(unlikely(FAV(QCWORD(y))->valencefns[0]==jtunquote && !(NAV(origname)->flag&(NMLOC|NMILOC|NMIMPLOC)))){ // reference is as reference does // the value is a non-locative reference to another reference. It is safe to skip over it. Leave y holding the value y=SYMVALTOFAOWED(y) ; // if global, mark to free later @@ -666,13 +670,11 @@ rdglob: ; // here when we tried the buckets and failed } endname: ; // obsolete y=SETNAMED(y); // turn on the flag bit indicating this was NAMED - }else{ + // else // not a name requiring lookup. enqueue() set the QC flags, which we will use below. We have just checked the NAMED flag, off here. Now we notionally switch to - // QCFAOWED semantics, in which QCISLKPNAME is repurposed to QCFAOWED (& known to be 0). enqueue() sets QCNAMED in blocks that are known to need no pretection from deletion: + // QCFAOWED semantics, in which QCISLKPNAME is repurposed to QCFAOWED (& known to be 0). enqueue() sets QCNAMED+~FAOWED in blocks that are known to need no pretection from deletion: // those are PERMANENT blocks and sentence words (together these amount to the entire sentence except for NAMEs). With FAOWED off we will know that the block needs no fa(), and the flags - // guarantee that the block is never protected from deletion - - // All this takes no code. + // guarantee that the block is never protected from deletion. } // names have been resolved @@ -873,7 +875,7 @@ RECURSIVERESULTSCHECK // obsolete if(ISSTKNAMED(tpopw)){INCRSTAT(wfaowed/*.36*/) if(unlikely(freep==y)){INCRSTAT(wfainh/*.02*/) y=(A)tpopw;}else {INCRSTAT(wfafa/*.98*/) faifowed(freep,freepc,freept,tpopw);}} if(ISSTKNAMED(tpopw)){INCRSTAT(wfaowed/*.7*/) if(unlikely((A)QCWORD(tpopw)==y)){INCRSTAT(wfainh/*.02*/) y=(A)tpopw;}else if(withprob(ISSTKFAOWED(tpopw),0.2)){INCRSTAT(wfafa/*.08*/) faowed((A)QCWORD(tpopw),AC((A)QCWORD(tpopw)),AT((A)QCWORD(tpopw)));}} // if the input is the result, keep the flags from the input, which are set to indicate required frees. The presence of one of these will suppress matching a also - else{ /*0.3*/ + else{ /*0.3*/ // tpopw points to the tpop stack, not the argument freea=*tpopw; // get the tstack pointer, which points back to the arg if it has not been zapped // obsolete I freeac=__atomic_load_n(&AC(freeav),__ATOMIC_RELAXED); I freeat=__atomic_load_n(&AT(freeav),__ATOMIC_RELAXED); I freeaflag=__atomic_load_n(&AFLAG(freeav),__ATOMIC_RELAXED); // obsolete // we start these loads here because the next branch will often mispredict, allowing them to finish. If we move them earlier we have more work to do with qualifying freea @@ -927,7 +929,7 @@ RECURSIVERESULTSCHECK // Handle early exits from exec loop: (1) line (0, impossible)/1/2 with AVN in pos 0; (2) (line 0/2, not LPAR in pos 0, finalexec). // If line 02 and the current word is (C)AVN and the next is also, stack 2 - // the likelys on the next 2 lines are required to get the compiler to avoid spilling queue or nextat + // the likelys on the next 2 lines are to get the compiler to avoid spilling queue or nextat if(likely((GETSTACK0PT&PTNOTLPAR)!=0)){ if(likely(STACK0PTISCAVN>=(pt0ecam&NOTFINALEXEC+(1LL<<(PMASKSAVEX+1))))){ // test is AVN or (NOTFINAL and pmask[1] both 0) // not ( and (AVN or !line1 & finalexec)): OK to skip the executable check @@ -972,7 +974,8 @@ RECURSIVERESULTSCHECK ramkrecursv(yy); // force recursive y while(1){ // for each stacked value, free the value unless it survives to the result, in which case it inherits the FAOWED. Only one FAOWED can be passed on this way - if(ISSTKFAOWED(arg1)){if(unlikely(QCWORD(arg1)==yy))yy=arg1;else faowed(QCWORD(arg1),__atomic_load_n(&AC(QCWORD(arg1)),__ATOMIC_RELAXED),__atomic_load_n(&AT(QCWORD(arg1)),__ATOMIC_RELAXED));} + if(unlikely(ISSTKFAOWED(arg1))){if(unlikely(QCWORD(arg1)==yy))yy=arg1;else faowed(QCWORD(arg1),__atomic_load_n(&AC(QCWORD(arg1)),__ATOMIC_RELAXED),__atomic_load_n(&AT(QCWORD(arg1)),__ATOMIC_RELAXED));} + // unlikely because modifiers apply usually to primitives if(arg2==0)break; arg1=arg2; arg2=arg3; arg3=0; }; // obsolete A freep=stack[1].a; diff --git a/jsrc/s.c b/jsrc/s.c index 24982543e..8a07c77fd 100644 --- a/jsrc/s.c +++ b/jsrc/s.c @@ -304,9 +304,9 @@ A probelocalbuckets(L *sympv,A a,LX lx,I bx){NM*u; // lx is LXAV0(locsyms)[buc } R 0; // no match. } else { - L* l = lx+sympv; // fetch hashchain headptr, point to L for first symbol + L* l=lx+sympv; // fetch hashchain headptr, point to L for first symbol // negative bucketx (now positive); skip that many items, and then you're at the right place - if(unlikely(bx>0)){NOUNROLL do{l = l->next+sympv;}while(--bx);} // skip the prescribed number, which is usually 1 + if(unlikely(bx>0)){NOUNROLL do{l=l->next+sympv;}while(--bx);} // skip the prescribed number, which is usually 1 R l->fval; } } diff --git a/jsrc/sc.c b/jsrc/sc.c index 3559c155d..e87d900e6 100644 --- a/jsrc/sc.c +++ b/jsrc/sc.c @@ -67,8 +67,9 @@ DF2(jtunquote){A z; }else{ // if long cacheable, don't allow short caching, else long cache would seldom get used (and it's faster) A cachedlocale=FAV(self)->localuse.lu0.cachedloc; UI4 vtime=FAV(self)->lu2.refvalidtime; // fetch before we read reftime as atomic if(vtime==ACVCACHEREAD){ // is previous lookup still valid - // The previous lookup can be reused because there have been no assignments - raposgblqcgsv(QCWORD(fs),QCPTYPE(fs),fs); // ra to match syrd1 scaf QCWORD not needed + // Short caching: the previous lookup can be reused because there have been no assignments +// obsolete raposgblqcgsv(QCWORD(fs),QCPTYPE(fs),fs); // ra to match syrd1 scaf QCWORD not needed + raposgblqcgsv(fs,0,fs); // ra to match syrd1. The 0 guarantees no recursion if(unlikely(NAV(thisname)->flag&NMLOC)){ // is this a (necessarily direct) locative? // see if the locale is cached. public_z_ =: entry_loc_ where entry_loc will have the locale pointer if(unlikely((explocale=cachedlocale)==0)){ // use cached locale if there is one (there will be, except first time through) If not... @@ -92,7 +93,7 @@ DF2(jtunquote){A z; if(likely(!(nmflgs&(NMLOC|NMILOC|NMIMPLOC)))) { // simple name, and not u./v. // We must not use bucket info for the local lookup, because the reference may have been created in a different context J jtx=(J)((I)jt+NAV(thisname)->m); C *sx=NAV(thisname)->s; UI4 hashx=NAV(thisname)->hash; - if(unlikely(AR(jt->locsyms)&ARHASACV)){if(unlikely((fs=CLRNAMEDLOC(jtprobe(jtx,sx,hashx,jt->locsyms)))!=0)){raposlocal(QCWORD(fs),fs); goto deflocal;}} // ACV is probably not in local, and we can even check to see. Set not-NAMEDLOC + if(unlikely(AR(jt->locsyms)&ARHASACV)){if(unlikely((fs=CLRNAMEDLOC(jtprobe(jtx,sx,hashx,jt->locsyms)))!=0)){raposlocal(QCWORD(fs),fs); goto deflocal;}} // ACV is probably not in local, and we can even check to see. Set not-NAMEDLOC. ra to match syrd1 fs=jtsyrd1(jtx,sx,hashx,jt->global); // not found in local, search global // leave LOCINCRDECR unset and jt->global unchnged deflocal:; @@ -121,8 +122,11 @@ DF2(jtunquote){A z; // explocale is the locale we are calling into ASSERTSUFF(fs!=0,EVVALUE,z=0; goto exitname;); // name must be defined I namedloc=(I)fs&QCNAMEDLOC; fs=QCWORD(fs); // extract NAMED flag from fs, clear other flags - // ** as of here we know there is a value for the name, and it has been ra()d. We must not take an error exit without fa + // ** as of here we know there is a value for the name, and it has been ra()d. We must not take an error exit without fa. fs has noQC semantics ASSERTSUFF(PARTOFSPEECHEQACV(AT(self),AT(fs)),EVDOMAIN,z=0; fa(fs); goto exitname;); // make sure its part of speech has not changed since the name was parsed; if error must use general fa + // at this point we could short-circuit names that call names (e. g. public =: name_loc_) by checking that the call is to jtunquote and is not a locative. This would save about half + // of this routine. It's not clear that the frequency is worth the test + // *** now that we know the lookup was valid, save it for next time, including locale if any // This is a little different between short- and long-term caches, because of the possibility that the // locale is numbered/private. Such locales are unsuitable for long-term caches since the locale @@ -130,12 +134,11 @@ DF2(jtunquote){A z; if(likely(!(FAV(self)->flag2&VF2CACHEABLE))){ // if only short-term cache is possible // for short-term cache, save the lookup, and the locale too if it is a direct locale (either named or numbered). if(!(nmflgs&NMILOC+NMIMPLOC)){ // Never cache anything for indirect or implicit locatives - FAV(self)->localuse.lu1.cachedlkp=fs; // save named lookup calc for next time should ra locale or make permanent? + FAV(self)->localuse.lu1.cachedlkp=fs; // save named lookup calc for next time should ra locale or make permanent? no QC if(nmflgs&NMLOC)FAV(self)->localuse.lu0.cachedloc=explocale; // including locale it is was looked up __atomic_store_n(&FAV(self)->lu2.refvalidtime,ACVCACHEREAD,__ATOMIC_RELEASE); // record timestamp of lookup } - } - else if(namedloc && (!(nmflgs&NMLOC) || (LXAV0(explocale)[SYMLEXECCT]&EXECCTPERM))){ // cacheable nameref, and value found in a permanent named locale + }else if(namedloc && (!(nmflgs&NMLOC) || (LXAV0(explocale)[SYMLEXECCT]&EXECCTPERM))){ // cacheable nameref, and value found in a permanent named locale // ************* the nameref is long-term cachable. Fill it in. Happens the first time a cachable reference is encountered. thisname=jt->curname; // refresh thisname // point the nameref to the lookup result. @@ -170,6 +173,7 @@ DF2(jtunquote){A z; WRITEUNLOCK(fs->lock); } } + }else{ // here for pseudo-named function. The actual name is in g, and the function itself is pointed to by h. The verb is an anonymous explicit modifier that has received operands (but not arguments) // The name is defined, but it has the value before the modifier operands were given, so ignore fields in it except for the name @@ -188,6 +192,7 @@ DF2(jtunquote){A z; } finlookup:; // here when short- or long-term cache hits. We know that no pun is possible on either cache hit // value of fs has been ra()d unless it was refcached or pseudo. We must undo that if there is error + #if NAMETRACK // bring out the name, locale, and script into easy-to-display name C trackinfo[256]; // will hold name followed by locale and scriptname @@ -225,8 +230,9 @@ finlookup:; // here when short- or long-term cache hits. We know that no pun i // We preserve the XDEFMODIFIER flag in jtinplace, because the type of the exec must not have been changed by name lookup. Pass the other inplacing flags through if the call supports inplacing z=(*actionfn)((J)((I)jt+((FAV(fs)->flag&(flgd0cpC&FLGMONAD+FLGDYAD)?JTFLAGMSK:JTXDEFMODIFIER)&flgd0cpC)),a,w,fs); // keep MODIFIER flag always, and others too if verb supports it if(unlikely(z==0)){jteformat(jt,jt->parserstackframe.sf,a,w,0);} // make this a format point - }else{jt=(J)((I)jt+((flgd0cpC+1)&0x200)); fs=jt->parserstackframe.sf; // jiggle jt to save clang register store, reinit fs + }else{ // Extra processing is required. Check each option individually + jt=(J)((I)jt+((flgd0cpC+1)&0x200)); fs=jt->parserstackframe.sf; // jiggle jt to save clang register store, reinit fs DC d=0; // pointer to debug stack frame, if one is allocated if(jt->uflags.trace){ // debug or pm // allocate debug stack frame if we are debugging OR PM'ing. In PM, we need a way to get the name being executed in an operator @@ -287,7 +293,7 @@ exitpop: ; if(unlikely(flgd0cpC&FLGLOCINCRDECR)){ACVCACHECLEAR; DECREXECCT(explocale)} // If we used a locative, undo its incr. If there were cocurrents, the incr was a while back // ************** errors OK now exitfa:; // error point for errors after symbol res. - // this is an RFO cycle that will cause trouble if there are many cores running the same names + // this is an RFO cycle that will cause trouble if there are many cores running the same names without cached lookups if(likely(!(flgd0cpC&(FLGCACHED|FLGPSEUDO)))){fanamedacv(fs);} // unra the name if it was looked up from the symbol tables 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. global and AKGST always match for the named explicit routine that is running. @@ -333,7 +339,7 @@ A jtnamerefacv(J jt, A a, A val){A y;V*v; // obsolete if(likely(val!=0)){if(LOCALRA||ISGLOBAL(val))fa(QCWORD(val))}else val=(A)QCVERB; // release the value, now that we don't need it (if global). If val was 0, get flags to install into reference to indicate [: is a verb if(likely(val!=0)){if(ISFAOWED(val))fa(QCWORD(val))}else val=(A)QCVERB; // release the value, now that we don't need it (if global). If val was 0, get flags to install into reference to indicate [: is a verb RZ(z); // abort if reference not allocated - if(likely(!(NAV(a)->flag&(NMILOC|NMIMPLOC)))){FAV(z)->localuse.lu1.cachedlkp=QCWORD(val); FAV(z)->lu2.refvalidtime=ACVCACHEREAD;} // install cachelet of lookup, but never if indirect locative + if(likely(!(NAV(a)->flag&(NMILOC|NMIMPLOC)))){FAV(z)->localuse.lu1.cachedlkp=QCWORD(val); FAV(z)->lu2.refvalidtime=ACVCACHEREAD;} // install cachelet of lookup, but never if indirect locative. No QC R (A)((I)z|QCPTYPE(val)); // Give the result the part of speech of the input. no FAOWED since we freed val; no NAMED since a reference is not a named value } @@ -359,7 +365,7 @@ F1(jtcreatecachedref){F1PREFIP;A z; ASSERT(val!=0,EVVALUE); // return if error or name not defined ASSERT(!(AT(val)&NOUN),EVDOMAIN) z=fdef(VF2CACHED+VF2CACHEABLE,CTILDE,AT(val), jtunquote,jtunquote, nm,0L,0L, (val->flag&VASGSAFE)+(VJTFLGOK1|VJTFLGOK2), FAV(val)->mr,lrv(FAV(val)),rrv(FAV(val)));// create reference - FAV(z)->localuse.lu1.cachedlkp=val; // install cached address of value + FAV(z)->localuse.lu1.cachedlkp=val; // install cached address of value, no QC ACSETPERM(val); // now that the value is cached, it lives forever RETF(z); } diff --git a/jsrc/xt.c b/jsrc/xt.c index 7ed15fd9c..9230445d8 100644 --- a/jsrc/xt.c +++ b/jsrc/xt.c @@ -283,7 +283,10 @@ foundsym:; // we found the symbol. Install its info. sym is the symbol, SYMNE RZ(deba(DCPARSE,wv,(A)wn,0L)); stackallo=1; } A *old=jt->tnextpushp; - t=qpc(); DQ(n, z=PARSERVALUE(parsea(wv,wn)); if(!z)break; if((UI)jt->tnextpushp-(UI)old>TPOPSLACK*SZI)tpop(old);); t=qpc()-t; // Run the sentence. No need to run as exec since the result doesn't escape. tpop like jtxdefn. no tpop on error. + t=qpc(); // start time + // We attempt to run as if under jtxdefn, so we check ATTN and jt->jerr as a replacement for reading from the word block; and we tpop like jtxdefn + DQ(n, z=PARSERVALUE(parsea(wv,wn)); if(unlikely(!z))break; ASSERT((__atomic_load_n((S*)JT(jt,adbreakr),__ATOMIC_ACQUIRE)&3)==0,EVATTN) RE(0) if((UI)jt->tnextpushp-(UI)old>TPOPSLACK*SZI)tpop(old);); + t=qpc()-t; // Run the sentence. No need to run as exec since the result doesn't escape. tpop like jtxdefn. no tpop on error. if(unlikely(stackallo))debz(); RZ(z); // if error, fail the timing request R scf(n?t/(n*pf):0); // convert processor freq to seconds, get time per iteration diff --git a/test/g000.ijs b/test/g000.ijs index fe566bb01..699152f2a 100644 --- a/test/g000.ijs +++ b/test/g000.ijs @@ -3,7 +3,7 @@ prolog './g000.ijs' NB. Early in the testing, verify that local assignments relocate the symbol table correctly 3 : 0 '' st =. 0 -st =. 15!:12 <'st' +st =. 15!:_1 <'st' for_l1. 'abcdefghijklmnopqrstuvwxyz' do. for_l2. 'abcdefghijklmnopqrstuvwxyz' do. (l1,l2) =. 26 #: l1_index,l2_index @@ -14,7 +14,7 @@ for_l1. 'abcdefghijklmnopqrstuvwxyz' do. assert (l1,l2)~ = 26 #: l1_index,l2_index end. end. -est =. 15!:12 <'st' +est =. 15!:_1 <'st' NB. This relocates when run early if. st ~: est do. smoutput 'symbols relocated' end. 1 )