Merge branch 'master' of jsoftware.com:jsource

jsrc/ao.c

@@ -529,7 +529,7 @@ A jtkeyct(J jt,A a,A w,A self,D toler){F2PREFIP;PROLOG(0009);A ai,z=0;I nitems;
  // wperm pristine so it can be used, but it's pristine only is w is zombie.  We sacrifice pristinity to inplaceability
  // the AM field of wperm is destroyed but that's OK because it never becomes a result
  I wprist=AFLAG(w)&AFPRISTINE;
- I wpprist=wprist&REPSGN(AC(w)&SGNIF(jtinplace,JTINPLACEWX));  // original pristinity of wperm
+ I wpprist=wprist&REPSGN(AC(w)&SGNIF((I)jtinplace,JTINPLACEWX));  // original pristinity of wperm
  AFLAGINIT(wperm,AFLAG(wperm)|wpprist)
  // We pass the self pointer for /. into cut, as it uses the id therein to interpret a
  z=jtcut2((J)(intptr_t)((I)jt+((FAV(self)->flag&VGERL)?0:(FAV(FAV(self)->fgh[0])->flag>>(VJTFLGOK1X-JTINPLACEWX))&JTINPLACEW)),frets,wperm,self);

jsrc/cu.c

@@ -40,7 +40,7 @@ A jtevery(J jt, A w, A fs){A * RESTRICT wv,x,z,* RESTRICT zv;
  // Get input pointer
  fauxblockINT(virtblockw,0,0);  // virtual block of rank 0, 0 atoms
  if(likely((flags&BOX)!=0)){virtw=C(*(wv=AAV(w)));  // if input is boxed, point to first box
-  if(ASGNINPLACESGN(SGNIF(jtinplace,JTINPLACEWX)&SGNIF(wflag,AFPRISTINEX),w))flags|=ACPERMANENT&-(wflag&RECURSIBLE);  // indicates inplaceability of boxed contents - only if recursive block
+  if(ASGNINPLACESGN(SGNIF((I)jtinplace,JTINPLACEWX)&SGNIF(wflag,AFPRISTINEX),w))flags|=ACPERMANENT&-(wflag&RECURSIBLE);  // indicates inplaceability of boxed contents - only if recursive block
  }else{
   // if input is not boxed, use a faux-virtual block to point to the atoms.  Repurpose unneeded wv to hold length
   fauxvirtual(virtw,virtblockw,w,0,ACUC1); AN(virtw)=1; wv=(A*)bpnoun(wt);  // note if w has gerunds, it is always boxed & doesn't go through here

jsrc/j.h

@@ -1109,7 +1109,7 @@ if(opt&0x100){ \
  gs=FAV(self)->fgh[1]; \
  if(!(opt&0x70)){fs=FAV(self)->fgh[0];} \
 } \
-A *tpopw=AZAPLOC(w); tpopw=(A*)((I)tpopw&REPSGN(SGNIF(jtinplace,JTINPLACEWX)&AC(w)&((AFLAG(w)&(AFVIRTUAL|AFUNINCORPABLE))-1))); tpopw=tpopw?tpopw:ZAPLOC0;  /* point to pointer to w (if it is inplace) */ \
+A *tpopw=AZAPLOC(w); tpopw=(A*)((I)tpopw&REPSGN(SGNIF((I)jtinplace,JTINPLACEWX)&AC(w)&((AFLAG(w)&(AFVIRTUAL|AFUNINCORPABLE))-1))); tpopw=tpopw?tpopw:ZAPLOC0;  /* point to pointer to w (if it is inplace) */ \
 w = PTROP(w,+,(I)jtinplace&JTINPLACEW); /* if w inplaceable, change the pointer to fail compares below */ \
 /* the call to h is not inplaceable, but it may allow WILLOPEN and USESITEMCOUNT (from the apropriate valence of g).  Inplace h if f is x@] */ \
 A hx; \
@@ -1178,8 +1178,8 @@ if(opt&0x100){ \
  gs=FAV(self)->fgh[1]; \
  if(opt&0x1000)fghfn=FAVV(hs)->valencefns[1]; \
 } \
-A *tpopw=AZAPLOC(w); tpopw=(A*)((I)tpopw&REPSGN(SGNIF(jtinplace,JTINPLACEWX)&AC(w)&((AFLAG(w)&(AFVIRTUAL|AFUNINCORPABLE))-1))); tpopw=tpopw?tpopw:ZAPLOC0;  /* point to pointer to w (if it is inplace) */ \
-A *tpopa=AZAPLOC(a); tpopa=(A*)((I)tpopa&REPSGN(SGNIF(jtinplace,JTINPLACEAX)&AC(a)&((AFLAG(a)&(AFVIRTUAL|AFUNINCORPABLE))-1))); tpopa=tpopa?tpopa:ZAPLOC0;  /* point to pointer to a (if it is inplace) */ \
+A *tpopw=AZAPLOC(w); tpopw=(A*)((I)tpopw&REPSGN(SGNIF((I)jtinplace,JTINPLACEWX)&AC(w)&((AFLAG(w)&(AFVIRTUAL|AFUNINCORPABLE))-1))); tpopw=tpopw?tpopw:ZAPLOC0;  /* point to pointer to w (if it is inplace) */ \
+A *tpopa=AZAPLOC(a); tpopa=(A*)((I)tpopa&REPSGN(SGNIF((I)jtinplace,JTINPLACEAX)&AC(a)&((AFLAG(a)&(AFVIRTUAL|AFUNINCORPABLE))-1))); tpopa=tpopa?tpopa:ZAPLOC0;  /* point to pointer to a (if it is inplace) */ \
 w = PTROP(w,+,(I)jtinplace&JTINPLACEW); a = PTROP(a,+,(I)jtinplace&JTINPLACEA);  /* if arg inplaceable, change the pointer to fail compares below */\
 /* the call to h is not inplaceable, but it may allow WILLOPEN and USESITEMCOUNT.  Inplace h if f is x@], but not if a==w  Actually we turn off all flags here if a==w, for comp ease */ \
 A hx; \

jsrc/k.c

@@ -997,7 +997,7 @@ A jtbcvt(J jt,C mode,A w){FPREFIP(J); A y,z=w;
  if((((AN(w)-1)|(AT(w)&CMPX)-1))>=0){  // not empty AND complex
   I allflag=1, anyflag=0; Z *wv = ZAV(w); DO(AN(w), I isflag=*(I*)&wv[i].im==NANFLAG; allflag&=isflag; anyflag|=isflag;)
   if(anyflag){
-   I ipok=SGNIF(jtinplace,JTINPLACEWX) & AC(w);  // both sign bits set (<0) if inplaceable
+   I ipok=SGNIF((I)jtinplace,JTINPLACEWX) & AC(w);  // both sign bits set (<0) if inplaceable
    if(allflag){
     if(ipok>=0)GATV(z,INT,AN(w),AR(w),AS(w));
     I *zv=IAV(z);  // output area

jsrc/va2.c

@@ -631,7 +631,7 @@ static A jtva2(J jt,AD * RESTRICT a,AD * RESTRICT w,AD * RESTRICT self,UI allran
     // 3: m=1 and nf=1: multiply m by mf, leave n  example: (shape 4 5) *"1 0 (shape 5)
     if(unlikely(((nf==1)+(n==1)+(m==1))>1)){  // 2 values=1, can lose a loop
      // migration is possible
-     n=(n*nf)^REPSGN(SGNIF(jtinplace,VIPWFLONGX)&(1-nf)); m*=mf;   // propagate mf and nf down; if n is not 1, complement if af<wf
+     n=(n*nf)^REPSGN(SGNIF((I)jtinplace,VIPWFLONGX)&(1-nf)); m*=mf;   // propagate mf and nf down; if n is not 1, complement if af<wf
      DPMULDE(nf,mf,mf);  // mf is total # iterations
      DPMULDE(zn,mf,zn)  // total # atoms in result
      mf=1;  // no outer loops.  nf immaterial.  zk does not need to change since it will not be used
@@ -697,8 +697,8 @@ static A jtva2(J jt,AD * RESTRICT a,AD * RESTRICT w,AD * RESTRICT self,UI allran
    // Establish the result area z; if we're reusing an argument, make sure the type is updated to the result type
    // If the operation is one that can fail partway through, don't allow it to overwrite a zombie input unless so enabled by the user
   // The ordering here assumes that jtinplace will usually be set
-  if(ASGNINPLACESGN(SGNIF(jtinplace,JTINPLACEWX),w)){z=w; I wt=AT(w), zt=rtype((I)jtinplace); zt=zt?zt:wt; if(unlikely(TYPESNE(wt,zt)))MODBLOCKTYPE(z,zt)  //  Uses JTINPLACEW==1
-  }else if(ASGNINPLACESGN(SGNIF(jtinplace,JTINPLACEAX),a)){z=a; I at=AT(a), zt=rtype((I)jtinplace); zt=zt?zt:at; if(unlikely(TYPESNE(at,zt)))MODBLOCKTYPE(z,zt)  //  Uses JTINPLACEA==2
+  if(ASGNINPLACESGN(SGNIF((I)jtinplace,JTINPLACEWX),w)){z=w; I wt=AT(w), zt=rtype((I)jtinplace); zt=zt?zt:wt; if(unlikely(TYPESNE(wt,zt)))MODBLOCKTYPE(z,zt)  //  Uses JTINPLACEW==1
+  }else if(ASGNINPLACESGN(SGNIF((I)jtinplace,JTINPLACEAX),a)){z=a; I at=AT(a), zt=rtype((I)jtinplace); zt=zt?zt:at; if(unlikely(TYPESNE(at,zt)))MODBLOCKTYPE(z,zt)  //  Uses JTINPLACEA==2
 #define scell AS((I)jtinplace&VIPWCRLONG?w:a)+((RANK2T)fr>>RANKTX)  // address of start of cell shape     shape of long cell+frame(long cell)
     // fr is (frame(long cell))  /  (shorter frame len)   /  (longer frame len)                      /   (longer frame len+longer celllen)
   }else{

jsrc/vf.c

@@ -164,7 +164,7 @@ F1(jtreverse){A z;C*wv,*zv;I f,k,m,n,nk,r,*v,*ws,wt,wr;
  wt=AT(w); wv=CAV(w);  // wv->source data
  PROD(m,f,ws); PROD(k,r-1,ws+f+1);  // m=# argument cells k=#atoms in one subitem
  k<<=bplg(wt); nk=n*k;  // k=#bytes in subitem  nk=#bytes in cell
- if((AC(w)&SGNIF(jtinplace,JTINPLACEWX))<0){z=w;}  // inplace: leave pristinity of w alone
+ if((AC(w)&SGNIF((I)jtinplace,JTINPLACEWX))<0){z=w;}  // inplace: leave pristinity of w alone
  else{GA(z,wt,AN(w),wr,ws); PRISTCLRF(w)}  // new copy: allocate new area, make w non-pristine since it escapes
  // w has been destroyed
  zv=CAV(z);  // zv->target data

jsrc/vfrom.c

@@ -570,8 +570,8 @@ DF2(jtfrom){A z;
     // We can't get away with changing the type for an INT atom a to BOX.  It would work if the a is not contents, but if it is pristine contents it will have
     // been made to appear inplaceable.  In that case, when we change the AT we have the usecount wrong, because the block is implicitly recursive by virtue
     // of being contents.  It's not a good trade to check for recursiveness of contents in tpop (currently implied).
-// obsolete     if((SGNIF(jtinplace,JTINPLACEAX)&AC(a)&SGNIFNOT(AFLAG(a),AFUNINCORPABLEX))<0)z=a; else{GAT0(z,INT,1,0)}
-    if((SGNIF(jtinplace,JTINPLACEAX)&AC(a)&(((AFLAG(a)|wt)&AFUNINCORPABLE+BOX)-1))<0)z=a; else{GAT0(z,INT,1,0)}
+// obsolete     if((SGNIF((I)jtinplace,JTINPLACEAX)&AC(a)&SGNIFNOT(AFLAG(a),AFUNINCORPABLEX))<0)z=a; else{GAT0(z,INT,1,0)}
+    if((SGNIF((I)jtinplace,JTINPLACEAX)&AC(a)&(((AFLAG(a)|wt)&AFUNINCORPABLE+BOX)-1))<0)z=a; else{GAT0(z,INT,1,0)}
     // Move the value and transfer the block-type
     I j; SETNDX(j,av,AN(w)); IAV(z)[0]=IAV(w)[j]; AT(z)=wt;   // change type only if the transfer succeeds, to avoid creating an invalid a block that eformat will look at
     // Here we transferred one I/A out of w.  We must mark w non-pristine.  If it was inplaceable, we can transfer the pristine status.  We overwrite w because it is no longer in use
@@ -1834,7 +1834,7 @@ static unsigned char jtekupdatex(J jt,struct ekctx* const ctx,UI4 ti){
 F2(jtekupdate){F2PREFIP;
  ARGCHK2(a,w);
  // extract the inputs
- A qk=w; ASSERT(AT(w)&FL,EVDOMAIN) ASSERT(ASGNINPLACESGN(SGNIF(jtinplace,JTINPLACEWX),w),EVNONCE)
+ A qk=w; ASSERT(AT(w)&FL,EVDOMAIN) ASSERT(ASGNINPLACESGN(SGNIF((I)jtinplace,JTINPLACEWX),w),EVNONCE)
  ASSERT(AT(a)&BOX,EVDOMAIN) ASSERT(AR(a)==1,EVRANK) ASSERT(AN(a)==5,EVLENGTH)  // a is 5 boxes
  A box0=C(AAV(a)[0]), box1=C(AAV(a)[1]), box2=C(AAV(a)[2]), box3=C(AAV(a)[3]), box4=C(AAV(a)[4]);
  A prx=box0; ASSERT(AT(prx)&INT,EVDOMAIN) ASSERT(AR(prx)<=1,EVRANK)  // prx is integer list or atom

jsrc/vg.c

@@ -420,7 +420,7 @@ static GF(jtgru1){F1PREFJT;A x,y;C4*wv;I i,*xv;US*u;void *yv;I c=ai*n;
 // grade INTs by hiding the item number in the value and sorting.  Requires ai==1.
 static GF(jtgriq){F1PREFJT;
  // For stability, we keep all the interior sorts ascending.  Here we set a code to precondition the values so that comes out right
- I gradedown=REPSGN(SGNIF(jtinplace,JTDESCENDX));  // ~0 if sorting down, else 0
+ I gradedown=REPSGN(SGNIF((I)jtinplace,JTDESCENDX));  // ~0 if sorting down, else 0
  // See how many bits we must reserve for the item number, and make a mask for the item number
  unsigned long hbit=CTLZI(n-1); ++hbit; I itemmask=((I)1<<hbit)-1;  // mask where the item number will go
  I itemmsb=(I)1<<(BW-1-hbit); I itemsigmsk=2*-itemmsb;  // get bit at place we will shift into sign bit, and a mask for all higher bits

test/g7x.ijs

@@ -13,7 +13,7 @@ space=:7!:2
 pr =: [             NB. for silent iteration
 NB. pr =: 1!:2&2    NB. to see each iteration
 
-chk=: ('FreeBSD'-:UNAME)
+chk=: (<UNAME) e. 'FreeBSD';'OpenBSD'
 
 f =: 3 : 0
  old=.sp ''

test/gtdot.ijs

@@ -4,6 +4,8 @@ NB. T. t. ------------------------------------------------------------------
 NB. **************************************** threads & tasks **********************************
 NB. 64-bit only
 
+chk=: (<UNAME) e. 'FreeBSD';'OpenBSD'
+
 3 : 0''
 if. IFWIN do.
  sleep=: usleep@>.@(1e6&*)
@@ -38,16 +40,16 @@ NB. no more thread can be created
 ('|ill-formed name'&([ -: #@[ {. ]) *. '(from pyx)'&([ -: -@#@[ {. ])) LF taketo  (>@[ 9!:59@0) :: ((13!:12)@(0$0) )  13!:8 t. '' 4  NB. pyx error is so flagged
 
 NB. delay
-pyx=. (6!:3) t. (<'worker';0) "0 [ 1#~('FreeBSD'-:UNAME){(3*N), 8
+pyx=: (6!:3) t. (<'worker';0) "0 [ 1#~chk{(3*N), 8
 1:&> pyx
 
-pyx=. (6!:3) t. (<'worker';0) "0 [ 0.1#~('FreeBSD'-:UNAME){(30*N), 8
+pyx=: (6!:3) t. (<'worker';0) "0 [ 0.1#~chk{(30*N), 8
 1:&> pyx
 
-pyx=. (6!:3) t. (<'worker';1) "0 [ 1#~('FreeBSD'-:UNAME){(3*N), 8
+pyx=: (6!:3) t. (<'worker';1) "0 [ 1#~chk{(3*N), 8
 1:&> pyx
 
-pyx=. (6!:3) t. (<'worker';1) "0 [ 0.1#~('FreeBSD'-:UNAME){(30*N), 8
+pyx=: (6!:3) t. (<'worker';1) "0 [ 0.1#~chk{(30*N), 8
 1:&> pyx
 
 f=: 4 : 0
@@ -215,7 +217,7 @@ N = 1 T.''
 wthr N
 
 NB. AMV
-amv =. 16 T. 0  NB. AMV with value 0
+amv =: 16 T. 0  NB. AMV with value 0
 0 = 17 T. amv,<1
 1 = 17 T. amv,<2
 3 = 17 T. amv,<1  NB. Now set to 4
@@ -246,11 +248,11 @@ amv =. 16 T. 0  NB. AMV with value 0
 
 f =: {{ vec =. 0$0 for. i. y do. vec =. vec , 17 T. x,<1 end. vec }}  NB. x is amv, y is # times to reserve 1
 wthr N
-amv =. 16 T. 0  NB. AMV with value 0
+amv =: 16 T. 0  NB. AMV with value 0
 (i. 30000) -: /:~ ; amv f t. ''"0 ] 3 $ 10000
 f =: {{ vec =. 0$0  for. i. y do. exp =. 0 while. $exp do. exp =. 18 T. x,des;exp [ des =. >:exp end. vec =. vec,des end. vec }}  NB. x is amv, y is # times to reserve 1
 wthr N
-amv =. 16 T. 0  NB. AMV with value 0
+amv =: 16 T. 0  NB. AMV with value 0
 (>: i. 3000) -: /:~ ; amv f t. ''"0 ] 3 $ 1000
 
 'domain error' -: ". etx '0 t. ($0)'
@@ -267,7 +269,7 @@ amv =. 16 T. 0  NB. AMV with value 0
 'limit error' -: 2 T. etx 8
 'limit error' -: ". etx '] t. 8'
 
-4!:55 ;:'allowlongjobs amv delth N N1 N2 f f1 f2 g g1 sleep wthr'
+4!:55 ;:'allowlongjobs amv chk delth N N1 N2 f f1 f2 g g1 pyx sleep wthr'
 
 epilog''