Mercurial > hg > jgplsrc

annotate vi.c @ 0:e0bbaa717f41 draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
lol J
author Jordi Gutiérrez Hermoso <jordigh@octave.org>
date Mon, 25 Nov 2013 11:56:30 -0500
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
1 /* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
2 /* License in license.txt. */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
3 /* */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
4 /* Verbs: Index-of */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
5
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
6 #include "j.h"
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
7
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
8
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
9 I ptab[]={
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10 53, 113, 241, 499, 1013,
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11 2029, 4079, 8179, 16369, 32749,
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12 65521, 131059, 262133, 524269, 1048559,
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13 2097133, 4194287, 8388593, 16777199, 33554393,
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14 67108837, 134217689, 268435399, 536870879
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15 };
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17 I nptab=sizeof(ptab)/SZI;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 /* Floating point (type D) byte order: */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20 /* Archimedes 3 2 1 0 7 6 5 4 */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21 /* VAX 1 0 3 2 5 4 7 6 */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22 /* little endian 7 6 5 4 3 2 1 0 */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23 /* ThinkC MAC universal 0 1 0 1 2 3 4 5 6 7 8 9 */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24 /* ThinkC MAC 6888x 0 1 _ _ 2 3 4 5 6 7 8 9 */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25 /* normal 0 1 2 3 4 5 6 7 ... */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27 #if SYS & SYS_LILENDIAN
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28 #define MSW 1 /* most significant word */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 #define LSW 0 /* least significant word */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31 #define MSW 0
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32 #define LSW 1
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35 static void ctmask(J jt){DI p,x,y;UINT c,d,e,m,q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36 p.d=PI; /* pi itself */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 x.d=PI*(1-jt->ct); /* lower bound */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 y.d=PI/(1-jt->ct); /* upper bound */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 c=p.i[MSW]; d=p.i[LSW]; m=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40 if(c==x.i[MSW]){e=x.i[LSW]; m =(d&~e)|(~d&e);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41 if(c==y.i[MSW]){e=y.i[LSW]; m|=(d&~e)|(~d&e);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42 q=m;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 while(m){m>>=1; q|=m;} /* q=:+./\m as a bit vector */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44 jt->ctmask=~(UI)q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45 } /* 1 iff significant wrt comparison tolerance */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48 /* hic: hash a string of length k */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 /* hicx: hash the bytes of string v indicated by hin/hiv */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50 /* hic2: hash the low order bytes of a string of length k (k even) */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51 /* hicw: hash a word (32 bit or 64 bit depending on CPU) */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53 UI hic ( I k,UC*v){UI z=0; DO(k, z=(i+1000003)**v++ ^z<<1; ); R z;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55 static UI hicnz( I k,UC*v){UI z=0;UC c; DO(k, c=*v++; if(c&&c!=255)z=(i+1000003)*c^z<<1;); R z;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 static UI hicx(J jt,I k,UC*v){UI z=0;I*u=jt->hiv; DO(jt->hin, z=(i+1000003)*v[*u++]^z<<1; ); R z;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59 #if SYS & SYS_LILENDIAN
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60 UI hic2( I k,UC*v){UI z=0; DO(k/2, z=(i+1000003)**v ^z<<1; v+=2;); R z;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 UI hic2( I k,UC*v){UI z=0; ++v; DO(k/2, z=(i+1000003)**v ^z<<1; v+=2;); R z;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65 #if SY_64
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66 #define hicw(v) (10495464745870458733U**(UI*)(v))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67 static UI jthid(J jt,D d){R 10495464745870458733U*(jt->ctmask&*(I*)&d);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69 #define hicw(v) (2838338383U**(U*)(v))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70 static UI jthid(J jt,D d){DI x; x.d=d; R 888888883U*(x.i[LSW]&jt->ctmask)+2838338383U*x.i[MSW];}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74 static UI jthia(J jt,D hct,A y){UC*yv;D d;I n,t;Q*u;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 n=AN(y); t=AT(y); yv=UAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76 if(!n||t&BOX)R hic(AR(y)*SZI,(UC*)AS(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77 switch(t){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78 case LIT: R hic(n,yv);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79 case C2T: R hic2(2*n,yv);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80 case SBT: R hic(n*SZI,yv);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 case B01: d=*(B*)yv; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 case INT: d=(D)*(I*)yv; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 case FL:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 case CMPX: d=*(D*)yv; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85 case XNUM: d=xdouble(*(X*)yv); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86 case RAT: u=(Q*)yv; d=xdouble(u->n)/xdouble(u->d);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88 R hid(d*hct);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 static UI jthiau(J jt,A y){I m,n;UC*v=UAV(y);UI z=2038074751;X*u,x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92 m=n=AN(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 if(!n)R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 switch(AT(y)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 case RAT: m+=n; /* fall thru */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96 case XNUM: u=XAV(y); DO(m, x=*u++; v=UAV(x); z+=hicnz(AN(x)*SZI,UAV(x));); R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97 case INT: z =hicnz(n *SZI,UAV(y)); R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98 default: R hic(n*bp(AT(y)),UAV(y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101 static UI hix(X*v){A y=*v; R hic(AN(y)*SZI,(UC*)AV(y));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102 static UI hiq(Q*v){A y=v->n; R hic(AN(y)*SZI,(UC*)AV(y));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105 static B jteqx(J jt,I n,X*u,X*v){DO(n, if(!equ(*u,*v))R 0; ++u; ++v;); R 1;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 static B jteqq(J jt,I n,Q*u,Q*v){DO(n, if(!QEQ(*u,*v))R 0; ++u; ++v;); R 1;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 static B jteqd(J jt,I n,D*u,D*v){DO(n, if(!teq(*u,*v))R 0; ++u; ++v;); R 1;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 static B jteqz(J jt,I n,Z*u,Z*v){DO(n, if(!zeq(*u,*v))R 0; ++u; ++v;); R 1;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110 static B jteqa(J jt,I n,A*u,A*v,I c,I d){DO(n, if(!equ(AADR(c,*u),AADR(d,*v)))R 0; ++u; ++v;); R 1;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 /*
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113 mode one of the following:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 0 IIDOT i. a w rank
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 1 IICO i: a w rank
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116 2 INUBSV ~: w rank
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 3 INUB ~. w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118 4 ILESS -. a w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119 5 INUBI I.@~: w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120 6 IEPS e. a w rank
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121 7 II0EPS e.i.0: a w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122 8 II1EPS e.i.1: a w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 9 IJ0EPS e.i:0: a w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124 10 IJ1EPS e.i:1: a w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125 11 ISUMEPS [:+ /e. a w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126 12 IANYEPS [:+./e. a w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127 13 IALLEPS [:*./e. a w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128 14 IIFBEPS I.@e. a w
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 30 IPHIDOT i. a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130 31 IPHICO i: a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131 34 IPHLESS -. a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
132 36 IPHEPS e. a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
133 37 IPHI0EPS e.i.0: a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
134 38 IPHI1EPS e.i.1: a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
135 39 IPHJ0EPS e.i:0: a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
136 40 IPHJ1EPS e.i:1: a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
137 41 IPHSUMEPS [:+ /e. a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
138 42 IPHANYEPS [:+./e. a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
139 43 IPHALLEPS [:*./e. a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
140 44 IPHIFBEPS I.@e. a w prehashed
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
141 m target axis length
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
142 n target item # elements
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
143 c # target items in a right arg cell
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
144 k target item # bytes
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
145 acr left rank
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
146 wcr right rank
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
147 ac # left arg cells
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
148 wc # right arg cells
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
149 ak # bytes left arg cells, or 0 if only one cell
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
150 wk # bytes right arg cells, or 0 if only one cell
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
151 a left arg
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
152 w right arg, or mark for m&i. or m&i: or e.&n or -.&n
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
153 hp pointer to hash table or to 0
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
154 z result
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
155 */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
156
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
157 #define IOF(f) A f(J jt,I mode,I m,I n,I c,I k,I acr,I wcr,I ac,I wc,I ak,I wk,A a,A w,A*hp,A z)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
158 #define IODECL(T) A h=*hp;B*zb;C*zc;D t1=1.0;I t=sizeof(T),acn=ak/t,cn=k/t,hj,*hv=AV(h),j,l,p=AN(h), \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
159 wcn=wk/t,*zi,*zv=AV(z);T*av=(T*)AV(a),*v,*wv=(T*)AV(w);UI pm=p
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
160 #define FIND(exp) while(m>(hj=hv[j])&&(exp)){++j; if(j==p)j=0;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
161 #define RDECL I ad=(I)a*ARELATIVE(a),wd=(I)w*ARELATIVE(w)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
162 #define ZISHAPE *AS(z)=AN(z)=zi-zv
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
163 #define ZCSHAPE *AS(z)=(zc-(C*)zv)/k; AN(z)=n**AS(z)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
164 #define ZUSHAPE(T) *AS(z)= zu-(T*)zv; AN(z)=n**AS(z)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
165
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
166
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
167 #define XDOA(hash,exp,inc) {d=ad; v=av; DO(m, j=(hash)%pm; FIND(exp); if(m==hj)hv[j]=i; inc;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
168 #define XDQA(hash,exp,dec) {d=ad; v=av+cn*(m-1); DQ(m, j=(hash)%pm; FIND(exp); if(m==hj)hv[j]=i; dec;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
169 #define XDO(hash,exp,inc,stmt) {d=wd; v=wv; DO(cm, j=(hash)%pm; FIND(exp); stmt; inc;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
170 #define XDQ(hash,exp,dec,stmt) {d=wd; v=wv+cn*(c-1); DQ(cm, j=(hash)%pm; FIND(exp); stmt; dec;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
171
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
172 #define XMV(hash,exp,inc,stmt) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
173 if(k==SZI){XDO(hash,exp,inc,if(m==hj){*zi++=*(I*)v; stmt;}); zc=(C*)zi;} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
174 else XDO(hash,exp,inc,if(m==hj){MC(zc,v,k); zc+=k; stmt;});
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
175
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
176 #define IOFX(T,f,hash,exp,inc,dec) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
177 IOF(f){RDECL;IODECL(T);B b;I cm,d,md,s;UC*u=0; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
178 md=mode<IPHOFFSET?mode:mode-IPHOFFSET; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
179 b=a==w&&ac==wc&&(mode==IIDOT||mode==IICO||mode==INUBSV||mode==INUB||mode==INUBI); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
180 zb=(B*)zv; zc=(C*)zv; zi=zv; cm=w==mark?0:c; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
181 for(l=0;l<ac;++l,av+=acn,wv+=wcn){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
182 if(mode<IPHOFFSET){DO(p,hv[i]=m;); if(!b){if(mode==IICO)XDQA(hash,exp,dec) else XDOA(hash,exp,inc);}} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
183 switch(md){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
184 case IIDOT: if(b){ XDO(hash,exp,inc,*zv++=m==hj?(hv[j]=i):hj);} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
185 else XDO(hash,exp,inc,*zv++=hj); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
186 case IICO: if(b){zi=zv+=c; XDQ(hash,exp,dec,*--zi=m==hj?(hv[j]=i):hj);} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
187 else XDO(hash,exp,inc,*zv++=hj); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
188 case INUBSV: XDO(hash,exp,inc,*zb++=m==hj?(hv[j]=i,1):0); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
189 case INUB: XMV(hash,exp,inc,hv[j]=i); ZCSHAPE; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
190 case ILESS: XMV(hash,exp,inc,0 ); ZCSHAPE; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
191 case INUBI: XDO(hash,exp,inc,if(m==hj)*zi++=hv[j]=i); ZISHAPE; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
192 case IEPS: XDO(hash,exp,inc,*zb++=m>hj); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
193 case II0EPS: s=c; XDO(hash,exp,inc,if(m==hj){s=i; break;}); *zi++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
194 case II1EPS: s=c; XDO(hash,exp,inc,if(m> hj){s=i; break;}); *zi++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
195 case IJ0EPS: s=c; XDQ(hash,exp,dec,if(m==hj){s=i; break;}); *zi++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
196 case IJ1EPS: s=c; XDQ(hash,exp,dec,if(m> hj){s=i; break;}); *zi++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
197 case ISUMEPS: s=0; XDO(hash,exp,inc,if(m> hj)++s; ); *zi++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
198 case IANYEPS: s=0; XDO(hash,exp,inc,if(m> hj){s=1; break;}); *zb++=1&&s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
199 case IALLEPS: s=1; XDO(hash,exp,inc,if(m==hj){s=0; break;}); *zb++=1&&s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
200 case IIFBEPS: s=c; XDO(hash,exp,inc,if(m> hj)*zi++=i ); ZISHAPE; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
201 }} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
202 R z; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
203 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
204
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
205 static IOFX(A,jtioax1,hia(t1,AADR(d,*v)),!equ(AADR(d,*v),AADR(ad,av[hj])),++v, --v ) /* boxed exact 1-element item */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
206 static IOFX(A,jtioau, hiau(AADR(d,*v)), !equ(AADR(d,*v),AADR(ad,av[hj])),++v, --v ) /* boxed uniform type */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
207 static IOFX(X,jtiox, hix(v), !eqx(n,v,av+n*hj), v+=cn, v-=cn) /* extended integer */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
208 static IOFX(Q,jtioq, hiq(v), !eqq(n,v,av+n*hj), v+=cn, v-=cn) /* rational number */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
209 static IOFX(C,jtioc, hic(k,(UC*)v), memcmp(v,av+k*hj,k), v+=cn, v-=cn) /* boolean, char, or integer */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
210 static IOFX(C,jtiocx, hicx(jt,k,(UC*)v), memcmp(v,av+k*hj,k), v+=cn, v-=cn) /* boolean, char, or integer */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
211 static IOFX(I,jtioi, hicw(v), *v!=av[hj], ++v, --v )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
212
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
213
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
214 #define HID(y) (888888883U*y.i[LSW]+2838338383U*y.i[MSW])
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
215 #define MASK(dd,xx) {dd.d=xx; dd.i[LSW]&=jt->ctmask;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
216 #define THASHA(expa) {x=*(D*)v; MASK(dx,x); j=HID(dx)%pm; FIND(expa); if(m==hj)hv[j]=i;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
217 #define THASHBX(expa) {j=hia(t1,AADR(d,*v))%pm; FIND(expa); if(m==hj)hv[j]=i;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
218
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
219 #define TFINDXY(expa,expw) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
220 {x=*(D*)v; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
221 MASK(dl,x*tl); j= HID(dl)%pm; FIND(expw); il=ir=hj; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
222 MASK(dr,x*tr); if(dr.d!=dl.d){j= HID(dr)%pm; FIND(expw); ir=hj;} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
223 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
224 #define TFINDYY(expa,expw) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
225 {x=*(D*)v; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
226 MASK(dx,x ); j=jx=HID(dx)%pm; jt->ct=0.0; FIND(expa); jt->ct=ct; if(m==hj)hv[j]=i; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
227 MASK(dl,x*tl); j=dl.d==dx.d?jx:HID(dl)%pm; FIND(expw); il=ir=hj; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
228 MASK(dr,x*tr); if(dr.d!=dl.d){j=dr.d==dx.d?jx:HID(dr)%pm; FIND(expw); ir=hj;} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
229 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
230 #define TFINDY1(expa,expw) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
231 {x=*(D*)v; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
232 MASK(dx,x ); j=jx=HID(dx)%pm; FIND(expa); if(m==hj)hv[j]=i; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
233 MASK(dl,x*tl); j=dl.d==dx.d?jx:HID(dl)%pm; FIND(expw); il=ir=hj; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
234 MASK(dr,x*tr); if(dr.d!=dl.d){j=dr.d==dx.d?jx:HID(dr)%pm; FIND(expw); ir=hj;} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
235 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
236 #define TFINDBX(expa,expw) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
237 {jx=j=hia(tl,AADR(d,*v))%pm; FIND(expw); il=ir=hj; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
238 j=hia(tr,AADR(d,*v))%pm; if(j!=jx){FIND(expw); ir=hj;} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
239 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
240 #define TDO(FXY,FYY,expa,expw,stmt) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
241 switch(4*bx+2*b+(k==sizeof(D))){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
242 default: DO(c, FXY(expa,expw); stmt; v+=cn;); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
243 case 1: DO(c, FXY(expa,expw); stmt; ++v; ); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
244 case 2: DO(c, FYY(expa,expw); stmt; v+=cn;); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
245 case 3: DO(c, FYY(expa,expw); stmt; ++v; ); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
246 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
247 #define TDQ(FXY,FYY,expa,expw,stmt) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
248 v+=cn*(c-1); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
249 switch(4*bx+2*b+(k==sizeof(D))){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
250 default: DQ(c, FXY(expa,expw); stmt; v-=cn;); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
251 case 1: DQ(c, FXY(expa,expw); stmt; --v; ); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
252 case 2: DQ(c, FYY(expa,expw); stmt; v-=cn;); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
253 case 3: DQ(c, FYY(expa,expw); stmt; --v; ); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
254 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
255 #define TMV(FXY,FYY,expa,expw,prop) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
256 switch(4*bx+2*b+(k==sizeof(D))){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
257 default: DO(c, FXY(expa,expw); if(prop){MC(zc,v,k); zc+=k;}; v+=cn;); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
258 case 1: DO(c, FXY(expa,expw); if(prop)*zd++=*(D*)v; ++v; ); zc=(C*)zd; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
259 case 2: DO(c, FYY(expa,expw); if(prop){MC(zc,v,k); zc+=k;}; v+=cn;); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
260 case 3: DO(c, FYY(expa,expw); if(prop)*zd++=*(D*)v; ++v; ); zc=(C*)zd; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
261 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
262
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
263
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
264 #define IOFT(T,f,FA,FXY,FYY,expa,expw) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
265 IOF(f){RDECL;IODECL(T);B b,bx;D ct=jt->ct,tl=1-jt->ct,tr=1/tl,x,*zd;DI dl,dr,dx;I d,e,il,ir,jx,md,s; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
266 md=mode<IPHOFFSET?mode:mode-IPHOFFSET; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
267 b=a==w&&ac==wc&&(mode==IIDOT||mode==IICO||mode==INUBSV||mode==INUB||mode==INUBI); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
268 zb=(B*)zv; zc=(C*)zv; zd=(D*)zv; zi=zv; e=cn*(m-1); bx=1&&BOX&AT(a); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
269 jx=0; dl.d=dr.d=dx.d=x=0.0; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
270 for(l=0;l<ac;++l,av+=acn,wv+=wcn){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
271 if(mode<IPHOFFSET){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
272 DO(p,hv[i]=m;); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
273 if(bx||!b){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
274 d=ad; v=av; jt->ct=0.0; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
275 if(IICO==mode){v+=e; DQ(m, FA(expa); v-=cn;);}else DO(m, FA(expa); v+=cn;); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
276 jt->ct=ct; if(w==mark)break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
277 }} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
278 d=wd; v=wv; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
279 switch(md){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
280 case IIDOT: TDO(FXY,FYY,expa,expw,*zv++=MIN(il,ir)); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
281 case IICO: zv+=c; TDQ(FXY,FYY,expa,expw,*--zv=m==il?ir:m==ir?il:MAX(il,ir)); zv+=c; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
282 case INUBSV: TDO(FXY,FYY,expa,expw,*zb++=i==MIN(il,ir)); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
283 case INUB: TMV(FXY,FYY,expa,expw,i==MIN(il,ir)); ZCSHAPE; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
284 case ILESS: TMV(FXY,FYY,expa,expw,m==il&&m==ir); ZCSHAPE; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
285 case INUBI: TDO(FXY,FYY,expa,expw,if(i==MIN(il,ir))*zi++=i;); ZISHAPE; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
286 case IEPS: TDO(FXY,FYY,expa,expw,*zb++=m>il||m>ir ); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
287 case II0EPS: s=c; TDO(FXY,FYY,expa,expw,if(m==il&&m==ir){s=i; break;}); *zi++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
288 case II1EPS: s=c; TDO(FXY,FYY,expa,expw,if(m> il||m> ir){s=i; break;}); *zi++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
289 case IJ0EPS: s=c; TDQ(FXY,FYY,expa,expw,if(m==il&&m==ir){s=i; break;}); *zi++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
290 case IJ1EPS: s=c; TDQ(FXY,FYY,expa,expw,if(m> il||m> ir){s=i; break;}); *zi++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
291 case ISUMEPS: s=0; TDO(FXY,FYY,expa,expw,if(m> il||m> ir)++s ); *zi++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
292 case IANYEPS: s=0; TDO(FXY,FYY,expa,expw,if(m> il||m> ir){s=1; break;}); *zb++=1&&s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
293 case IALLEPS: s=1; TDO(FXY,FYY,expa,expw,if(m==il&&m==ir){s=0; break;}); *zb++=1&&s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
294 case IIFBEPS: TDO(FXY,FYY,expa,expw,if(m> il||m> ir)*zi++=i ); ZISHAPE; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
295 }} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
296 R z; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
297 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
298
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
299 static IOFT(Z,jtioz, THASHA, TFINDXY,TFINDYY,memcmp(v,av+n*hj,n*2*sizeof(D)), !eqz(n,v,av+n*hj) )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
300 static IOFT(Z,jtioz1,THASHA, TFINDXY,TFINDYY,memcmp(v,av+n*hj, 2*sizeof(D)), !zeq( *v,av[hj] ) )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
301 static IOFT(D,jtiod, THASHA, TFINDXY,TFINDYY,memcmp(v,av+n*hj,n* sizeof(D)), !eqd(n,v,av+n*hj) )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
302 static IOFT(D,jtiod1,THASHA, TFINDXY,TFINDY1,x!=av[hj], !teq(x,av[hj] ) )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
303 static IOFT(A,jtioa, THASHBX,TFINDBX,TFINDBX,!eqa(n,v,av+n*hj,d,ad), !eqa(n,v,av+n*hj,d,ad) )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
304 static IOFT(A,jtioa1,THASHBX,TFINDBX,TFINDBX,!equ(AADR(d,*v),AADR(ad,av[hj])),!equ(AADR(d,*v),AADR(ad,av[hj])))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
305
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
306
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
307 #define SDO(v0) if(mode<IPHOFFSET){B v1=!(v0); memset(hv,v0,p); u=av; DO(m, hb[*u++]=v1;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
308 #define SDOA if(mode<IPHOFFSET){DO(p,hv[i]=m; ); u=av; DO(m,hu[*u++]=i;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
309 #define SDQA if(mode<IPHOFFSET){DO(p,hv[i]=m; ); u=av+m; DQ(m,hu[*--u]=i;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
310
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
311 #define SDOW(stmt) {u=wv; DO(cm, stmt;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
312
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
313 #define SCOZ(hh,zz,vv) {u=wv; DO(cm, zz=hh[*u++]; );}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
314 #define SCOZ1(hh,zz,vv) {u=wv; DO(cm, x=*u++; zz=min<=x&&x<max?hh[x]:vv;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
315
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
316 #define SCOW(hh,stmt) {u=wv; DO(cm, if( hh[ *u++]){stmt;});}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
317 #define SCOWX(hh,stmt) {u=wv; DO(cm, if( hh[x=*u++]){stmt;});}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
318 #define SCOW1(hh,stmt) {u=wv; DO(cm, x=*u++; if(min<=x&&x< max&&hh[x ]){stmt;});}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
319 #define SCOW0(hh,stmt) {u=wv; DO(cm, x=*u++; if(x<min ||max<=x||hh[x ]){stmt;});}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
320
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
321 #define SCQW(hh,stmt) {u=wv+c; DQ(cm, if( hh[ *--u]){stmt;});}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
322 #define SCQW1(hh,stmt) {u=wv+c; DQ(cm, x=*--u; if(min<=x&&x< max&&hh[x ]){stmt;});}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
323 #define SCQW0(hh,stmt) {u=wv+c; DQ(cm, x=*--u; if(x<min ||max<=x||hh[x ]){stmt;});}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
324
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
325 #define IOFSMALLRANGE(f,T,COZ1,COW0,COW1,COWX,CQW0,CQW1) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
326 IOF(f){A h=*hp;B b,*hb,*zb;I cm,e,*hu,*hv,l,max,md,min,p,s,*v,*zi,*zv;T*av,*u,*wv,x,*zu; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
327 md=mode<IPHOFFSET?mode:mode-IPHOFFSET; b=(mode==IIDOT||mode==IICO)&&a==w&&ac==wc; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
328 av=(T*)AV(a); wv=(T*)AV(w); zv=zi=AV(z); zb=(B*)zv; zu=(T*)zv; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
329 p=AN(h); min=jt->min; max=p+min; hv=AV(h); hb=(B*)hv-min; hu=hv-min; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
330 e=1==wc?0:c; cm=w==mark?0:c; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
331 for(l=0;l<ac;++l,av+=m,wv+=e){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
332 if(b){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
333 if(mode==IIDOT){DO(p,hv[i]=-1;); u=wv; DO(m, v=hu+*u++; if(0>*v)*v=i; *zv++=*v;); } \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
334 else {DO(p,hv[i]=-1;); u=wv+m; zv+=m; DQ(m, v=hu+*--u; if(0>*v)*v=i; *--zv=*v;); zv+=m;} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
335 }else switch(md){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
336 case INUBSV: memset(hv,C1,p); SDOW(if(*zb++=hb[x=*u++])hb[x]=0); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
337 case INUB: memset(hv,C1,p); SDOW(if(hb[x=*u++]){*zu++=x; hb[x]=0;}); ZUSHAPE(T); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
338 case INUBI: memset(hv,C1,p); SDOW(if(hb[x=*u++]){*zi++=i; hb[x]=0;}); ZISHAPE; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
339 case IIDOT: SDQA; COZ1(hu, *zv++, m); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
340 case IICO: SDOA; COZ1(hu, *zv++, m); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
341 case IEPS: SDO(C0); COZ1(hb, *zb++, 0); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
342 case ILESS: SDO(C1); COWX(hb, *zu++=x ); ZUSHAPE(T); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
343 case II0EPS: SDO(C1); s=c; COW0(hb, s=i; break); *zv++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
344 case II1EPS: SDO(C0); s=c; COW1(hb, s=i; break); *zv++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
345 case IJ0EPS: SDO(C1); s=c; CQW0(hb, s=i; break); *zv++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
346 case IJ1EPS: SDO(C0); s=c; CQW1(hb, s=i; break); *zv++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
347 case IANYEPS: SDO(C0); s=0; COW1(hb, s=1; break); *zb++=1&&s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
348 case IALLEPS: SDO(C1); s=1; COW0(hb, s=0; break); *zb++=1&&s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
349 case ISUMEPS: SDO(C0); s=0; COW1(hb, ++s ); *zv++=s; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
350 case IIFBEPS: SDO(C0); COW1(hb, *zi++=i ); ZISHAPE; break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
351 }} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
352 R z; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
353 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
354
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
355 static IOFSMALLRANGE(jtio1,UC,SCOZ, SCOW, SCOW, SCOWX,SCQW, SCQW ) /* 1-byte items */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
356 static IOFSMALLRANGE(jtio2,US,SCOZ, SCOW, SCOW, SCOWX,SCQW, SCQW ) /* 2-byte items */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
357 static IOFSMALLRANGE(jtio4,I ,SCOZ1,SCOW0,SCOW1,SCOW0,SCQW0,SCQW1) /* word size items */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
358
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
359
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
360 #define SCDO(T,xe,exp) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
361 {T*av=(T*)u,*v0=(T*)v,*wv=(T*)v,x; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
362 switch(mode){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
363 case IIDOT: DO(ac, DO(c, x=(xe); j=0; while(m>j &&(exp))++j; *zv++=j; wv+=q;); av+=p; if(1==wc)wv=v0;); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
364 case IICO: DO(ac, DO(c, x=(xe); j=m-1; while(0<=j&&(exp))--j; *zv++=0>j?m:j; wv+=q;); av+=p; if(1==wc)wv=v0;); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
365 case IEPS: DO(ac, DO(c, x=(xe); j=0; while(m>j &&(exp))++j; *zb++=m>j; wv+=q;); av+=p; if(1==wc)wv=v0;); break; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
366 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
367
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
368 static IOF(jtiosc){B*zb;I j,p,q,*u,*v,zn,*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
369 p=1<ac?m:0; q=1<wc||1<c;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
370 zn=AN(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
371 zv=AV(z); zb=(B*)zv; u=AV(a); v=AV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
372 switch(AT(a)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
373 default: SCDO(C, *wv,x!=av[j] ); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
374 case C2T: SCDO(S, *wv,x!=av[j] ); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
375 case CMPX: SCDO(Z, *wv,!zeq(x, av[j])); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
376 case XNUM: SCDO(A, *wv,!equ(x, av[j])); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
377 case RAT: SCDO(Q, *wv,!QEQ(x, av[j])); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
378 case INT: SCDO(I, *wv,x!=av[j] ); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
379 case SBT: SCDO(SB,*wv,x!=av[j] ); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
380 case BOX: {RDECL; SCDO(A, AADR(wd,*wv),!equ(x,AADR(ad,av[j])));} break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
381 case FL: if(0==jt->ct)SCDO(D, *wv,x!=av[j])
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
382 else SCDO(D, *wv,!teq(x,av[j]));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
383 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
384 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
385 } /* right argument cell is scalar; only for modes IIDOT IICO IEPS */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
386
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
387
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
388 static B jtusebs(J jt,A a,I ac,I m){A*av,x;I ad,t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
389 if(!(BOX&AT(a)&&0==jt->ct))R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
390 av=AAV(a); ad=(I)a*ARELATIVE(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
391 DO(ac*m, x=AVR(i); t=AT(x); if(t&BOX+CMPX||1<AN(x)&&t&NUMERIC)R 1;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
392 R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
393 } /* n (# elements in a target item) is assumed to be 1 */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
394
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
395 static A jtnodupgrade(J jt,A a,I acr,I ac,I acn,I ad,I n,I m,B b,B bk){A*av,h,*u,*v;I*hi,*hu,*hv,l,m1,q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
396 RZ(h=irs1(a,0L,acr,jtgrade1)); hv=AV(h)+bk*(m-1); av=AAV(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
397 if(!b)for(l=0;l<ac;++l,av+=acn,hv+=m){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
398 hi=hv; q=*hi; u=av+n*q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
399 if(bk){hu=--hi; DO(m-1, q=*hi--; v=av+n*q; if(!eqa(n,u,v,ad,ad)){u=v; *hu--=q;}); m1=hv-hu; if(m>m1)hv[1-m]=1-m1;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
400 else {hu=++hi; DO(m-1, q=*hi++; v=av+n*q; if(!eqa(n,u,v,ad,ad)){u=v; *hu++=q;}); m1=hu-hv; if(m>m1)hv[m-1]=1-m1;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
401 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
402 R h;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
403 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
404
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
405 #define BSLOOPAA(hiinc,zstmti,zstmt1,zstmt0) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
406 {A*u=av,*v;I*hi=hv,p,q; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
407 p=*hiinc; u=av+n*p; zstmti; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
408 DO(m-1, q=*hiinc; v=av+n*q; if(eqa(n,u,v,ad,ad))zstmt1; else{u=v; zstmt0;}); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
409 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
410
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
411 #define BSLOOPAWX(ii,icmp,iinc,uinc,zstmt) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
412 {A*u=wv+n*(ii),*v;I i,j,p,q;int t; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
413 for(i=ii;icmp;iinc,uinc){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
414 p=0; q=m1; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
415 while(p<=q){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
416 t=0; j=(p+q)/2; v=av+n*hu[j]; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
417 DO(n, if(t=compare(AADR(wd,u[i]),AADR(ad,v[i])))break;); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
418 if(0<t)p=j+1; else q=t?j-1:-2; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
419 } \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
420 zstmt; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
421 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
422
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
423 #define BSLOOPAW(zstmt) BSLOOPAWX(0 ,i< c,++i,u+=n,zstmt)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
424 #define BSLOOQAW(zstmt) BSLOOPAWX(c-1,i>=0,--i,u-=n,zstmt)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
425
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
426 static IOF(jtiobs){A*av,h=*hp,*wv,y;B b,bk,*yb,*zb;C*zc;I acn,ad,*hu,*hv,l,m1,md,s,wcn,wd,*zi,*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
427 bk=mode==IICO||mode==IJ0EPS||mode==IJ1EPS||mode==IPHICO||mode==IPHJ0EPS||mode==IPHJ1EPS;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
428 b=a==w&&ac==wc&&(mode==IIDOT||mode==IICO||mode==INUB||mode==INUBSV||mode==INUBI);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
429 if(mode==INUB||mode==INUBI){GA(y,B01,m,1,0); yb=BAV(y);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
430 md=w==mark?-1:mode<IPHOFFSET?mode:mode-IPHOFFSET;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
431 av=AAV(a); ad=(I)a*ARELATIVE(a); acn=ak/sizeof(A);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
432 wv=AAV(w); wd=(I)w*ARELATIVE(w); wcn=wk/sizeof(A);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
433 zi=zv=AV(z); zb=(B*)zv; zc=(C*)zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
434 if(mode<IPHOFFSET)RZ(*hp=h=nodupgrade(a,acr,ac,acn,ad,n,m,b,bk));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
435 if(w==mark)R mark;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
436 hv=AV(h)+bk*(m-1); jt->complt=-1; jt->compgt=1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
437 for(l=0;l<ac;++l,av+=acn,wv+=wcn,hv+=m){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
438 s=hv[bk?1-m:m-1]; m1=0>s?-s:m-1; hu=hv-m1*bk;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
439 if(b)switch(md){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
440 case IIDOT: BSLOOPAA(hi++,zv[p]=p,zv[q]=p,zv[q]=p=q); zv+=m; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
441 case IICO: BSLOOPAA(hi--,zv[p]=p,zv[q]=p,zv[q]=p=q); zv+=m; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
442 case INUBSV: BSLOOPAA(hi++,zb[p]=1,zb[q]=0,zb[q]=1 ); zb+=m; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
443 case INUB: BSLOOPAA(hi++,yb[p]=1,yb[q]=0,yb[q]=1 ); DO(m, if(yb[i]){MC(zc,av+i*n,k); zc+=k;}); ZCSHAPE; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
444 case INUBI: BSLOOPAA(hi++,yb[p]=1,yb[q]=0,yb[q]=1 ); DO(m, if(yb[i])*zi++=i;); ZISHAPE; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
445 }else switch(md){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
446 case IIDOT: BSLOOPAW(*zv++=-2==q?hu[j]:m); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
447 case IICO: BSLOOPAW(*zv++=-2==q?hu[j]:m); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
448 case IEPS: BSLOOPAW(*zb++=-2==q); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
449 case ILESS: BSLOOPAW(if(-2< q){MC(zc,u,k); zc+=k;}); ZCSHAPE; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
450 case II0EPS: s=m; BSLOOPAW(if(-2< q){s=i; break;}); *zi++=s; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
451 case IJ0EPS: s=m; BSLOOQAW(if(-2< q){s=i; break;}); *zi++=s; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
452 case II1EPS: s=m; BSLOOPAW(if(-2==q){s=i; break;}); *zi++=s; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
453 case IJ1EPS: s=m; BSLOOQAW(if(-2==q){s=i; break;}); *zi++=s; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
454 case IANYEPS: s=0; BSLOOPAW(if(-2==q){s=1; break;}); *zb++=1&&s; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
455 case IALLEPS: s=1; BSLOOPAW(if(-2< q){s=0; break;}); *zb++=1&&s; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
456 case ISUMEPS: s=0; BSLOOPAW(if(-2==q)++s); *zi++=s; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
457 case IIFBEPS: BSLOOPAW(if(-2==q)*zi++=i); ZISHAPE; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
458 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
459 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
460 } /* a i.!.0 w on boxed a,w by grading and binary search */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
461
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
462 static I jtutype(J jt,A w,I c){A*wv,x;I m,t,wd;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
463 if(!AN(w))R 1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
464 m=AN(w)/c; wv=AAV(w); wd=(I)w*ARELATIVE(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
465 DO(c, t=0; DO(m, x=WVR(i); if(AN(x)){if(t)RZ(t==AT(x)) else{t=AT(x); if(t&FL+CMPX+BOX)R 0;}}););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
466 R t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
467 } /* return type if opened atoms of cells of w has uniform type, else 0. c is # of cells */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
468
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
469 I hsize(I m){I q=m+m,*v=ptab; DO(nptab-1, if(q<=*v)break; ++v;); R*v;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
470
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
471
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
472 A jtindexofsub(J jt,I mode,A a,A w){PROLOG;A h=0,hi=mtv,z=mtv;AF fn;B mk=w==mark,th;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
473 I ac,acr,af,ak,ar,*as,at,c,f,f1,k,k1,m,n,p,r,*s,ss,t,wc,wcr,wf,wk,wr,*ws,wt,zn;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
474 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
475 ar=AR(a); acr=jt->rank?jt->rank[0]:ar; af=ar-acr;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
476 wr=AR(w); wcr=jt->rank?jt->rank[1]:wr; wf=wr-wcr; jt->rank=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
477 as=AS(a); at=AT(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
478 ws=AS(w); wt=AT(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
479 if(mk){f=af; s=as; r=acr-1; f1=wcr-r;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
480 else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
481 f=af?af:wf; s=af?as:ws; r=acr?acr-1:0; f1=wcr-r;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
482 if(0>f1||ICMP(as+af+1,ws+wf+f1,r)){I f0,*v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
483 m=acr?as[af]:1; f0=MAX(0,f1); RE(zn=mult(prod(f,s),prod(f0,ws+wf)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
484 switch(mode){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
485 case IIDOT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
486 case IICO: GA(z,INT,zn,f+f0,s); if(af)ICPY(f+AS(z),ws+wf,f0); v=AV(z); DO(zn, *v++=m;); R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
487 case IEPS: GA(z,B01,zn,f+f0,s); if(af)ICPY(f+AS(z),ws+wf,f0); memset(BAV(z),C0,zn); R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
488 case ILESS: R ca(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
489 case IIFBEPS: R mtv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
490 case IANYEPS: case IALLEPS: case II0EPS: R zero;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
491 case ISUMEPS: R sc(0L);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
492 case II1EPS: case IJ1EPS: R sc(zn);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
493 case IJ0EPS: R sc(zn-1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
494 case INUBSV: case INUB: case INUBI: ASSERTSYS(0,"indexofsub"); // impossible
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
495 }}}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
496 if(at&SPARSE||wt&SPARSE){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
497 if(1>=acr)R af?sprank2(a,w,0L,acr,RMAX,jtindexof):wt&SPARSE?iovxs(mode,a,w):iovsd(mode,a,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
498 if(af||wf)R sprank2(a,w,0L,acr,wcr,jtindexof);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
499 switch((at&SPARSE?2:0)+(wt&SPARSE?1:0)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
500 case 1: EPILOG(indexofxx(mode,a,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
501 case 2: EPILOG(indexofxx(mode,a,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
502 case 3: EPILOG(indexofss(mode,a,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
503 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
504 m=acr?as[af]:1; n=acr?prod(acr-1,as+af+1):1; RE(zn=mult(prod(f,s),prod(f1,ws+wf)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
505 RE(t=mk?at:maxtype(at,wt)); k1=bp(t); k=n*k1; th=HOMO(at,wt); jt->min=ss=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
506 ac=prod(af,as); ak=ac?k1*AN(a)/ac:0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
507 wc=prod(wf,ws); wk=wc?k1*AN(w)/wc:0; c=1<ac?wk/k:zn; wk*=1<wc;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
508 if(th&&t!=at)RZ(a=t&XNUM?xcvt(XMEXMT,a):cvt(t,a)) else if(t&FL+CMPX )RZ(a=cvt0(a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
509 if(th&&t!=wt)RZ(w=t&XNUM?xcvt(XMEXMT,w):cvt(t,w)) else if(t&FL+CMPX&&a!=w)RZ(w=cvt0(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
510 if(AT(a)&INT+SBT&&k==SZI){I r; irange(AN(a)*k1/SZI,AV(a),&r,&ss); if(ss){jt->min=r;}}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
511 p=1==k?(t&B01?2:256):2==k?(t&B01?258:65536):k==SZI&&ss&&ss<2.1*MAX(m,c)?ss:hsize(m);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
512 if(!mk)switch(mode){I q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
513 case IIDOT:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
514 case IICO: GA(z,INT,zn,f+f1, s); if(af)ICPY(f+AS(z),ws+wf,f1); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
515 case INUBSV: GA(z,B01,zn,f+f1+!acr,s); if(af)ICPY(f+AS(z),ws+wf,f1); if(!acr)*(AS(z)+AR(z)-1)=1; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
516 case INUB: q=MIN(m,p); GA(z,t,mult(q,aii(a)),MAX(1,wr),ws); *AS(z)=q; break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
517 case ILESS: GA(z,t,AN(w),MAX(1,wr),ws); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
518 case IEPS: GA(z,B01,zn,f+f1, s); if(af)ICPY(f+AS(z),ws+wf,f1); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
519 case INUBI: q=MIN(m,p); GA(z,INT,q,1,0); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
520 case IIFBEPS: GA(z,INT,c,1,0); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
521 case IANYEPS: case IALLEPS:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
522 GA(z,B01,1,0,0); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
523 case II0EPS: case II1EPS: case IJ0EPS: case IJ1EPS: case ISUMEPS:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
524 GA(z,INT,1,0,0); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
525 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
526 if(!(mk||m&&n&&zn&&th))switch(mode){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
527 case IIDOT: R reshape(shape(z),sc(n?m:0 ));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
528 case IICO: R reshape(shape(z),sc(n?m:m-1));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
529 case INUBSV: R reshape(shape(z),take(sc(m),one));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
530 case INUB: AN(z)=0; *AS(z)=m?1:0; R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
531 case ILESS: if(m)AN(z)=*AS(z)=0; else MC(AV(z),AV(w),k1*AN(w)); R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
532 case IEPS: R reshape(shape(z),m&&(!n||th)?one:zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
533 case INUBI: R m?iv0:mtv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
534 case II0EPS: R sc(n?0L :c );
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
535 case II1EPS: R sc(n?c :0L );
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
536 case IJ0EPS: R sc(n?MAX(0,c-1):c );
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
537 case IJ1EPS: R sc(n?c :MAX(0,c-1));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
538 case ISUMEPS: R sc(n?0L :c );
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
539 case IANYEPS: R n?zero:one;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
540 case IALLEPS: R c&&n?zero:one;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
541 case IIFBEPS: R n?mtv :IX(c);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
542 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
543 if(a!=w&&!mk&&1==acr&&(1==wc||ac==wc)&&(D)m*n*zn<13*((D)m*n+zn)&&(mode==IIDOT||mode==IICO||mode==IEPS)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
544 fn=jtiosc;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
545 }else{B b=0==jt->ct;I ht=INT,t1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
546 if(!b&&t&BOX+FL+CMPX)ctmask(jt);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
547 if (t&BOX) fn=b&&(1<n||usebs(a,ac,m))?jtiobs:1<n?jtioa:b?jtioax1:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
548 (t1=utype(a,ac))&&(mk||a==w||t1==utype(w,wc))?jtioau:jtioa1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
549 else if(t&XNUM) fn=jtiox;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
550 else if(t&RAT ) fn=jtioq;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
551 else if(1==k) {fn=jtio1; if(!(mode==IIDOT||mode==IICO))ht=B01;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
552 else if(2==k) {fn=jtio2; if(!(mode==IIDOT||mode==IICO))ht=B01;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
553 else if(k==SZI&&!(t&FL)){if(p==ss){fn=jtio4; if(!(mode==IIDOT||mode==IICO))ht=B01;}else fn=jtioi;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
554 else fn=b||t&B01+JCHAR+INT+SBT?jtioc:1==n?(t&FL?jtiod1:jtioz1):t&FL?jtiod:jtioz;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
555 if(fn!=jtiobs)GA(h,ht,p,1,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
556 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
557 if(fn==jtioc){A x;B*b;C*u,*v;I*d,q;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
558 GA(x,B01,k,1,0); b=BAV(x); memset(b,C1,k);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
559 q=k; u=CAV(a); v=u+k;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
560 DO(ac*(m-1), DO(k, if(u[i]!=*v&&b[i]){b[i]=0; --q;} ++v;); if(!q)break;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
561 if(q){jt->hin=k-q; GA(hi,INT,k-q,1,0); jt->hiv=d=AV(hi); DO(k, if(!b[i])*d++=i;); fn=jtiocx;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
562 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
563 RZ(fn(jt,mode,m,n,c,k,acr,wcr,ac,wc,ak,wk,a,w,&h,z));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
564 if(mk){A x,*zv;I*xv,ztype;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
565 GA(z,BOX,3,1,0); zv=AAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
566 GA(x,INT,6,1,0); xv=AV(x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
567 switch(mode){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
568 default: ztype=0; break; /* integer vector */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
569 case ILESS: ztype=1; break; /* type/shape from arg */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
570 case IEPS: ztype=2; break; /* boolean vector */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
571 case IANYEPS: case IALLEPS: ztype=3; break; /* boolean scalar */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
572 case ISUMEPS:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
573 case II0EPS: case II1EPS:
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
574 case IJ0EPS: case IJ1EPS: ztype=4; /* integer scalar */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
575 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
576 xv[0]=mode; xv[1]=n; xv[2]=k; xv[3]=jt->min; xv[4]=(I)fn; xv[5]=ztype;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
577 zv[0]=x; zv[1]=h; zv[2]=hi;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
578 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
579 EPILOG(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
580 } /* a i."r w main control */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
581
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
582 A jtindexofprehashed(J jt,A a,A w,A hs){A h,hi,*hv,x,z;AF fn;I ar,*as,at,c,f1,k,m,mode,n,
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
583 r,t,*xv,wr,*ws,wt,ztype;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
584 RZ(a&&w&&hs);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
585 hv=AAV(hs); x=hv[0]; h=hv[1]; hi=hv[2];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
586 xv=AV(x); mode=xv[0]; n=xv[1]; k=xv[2]; jt->min=xv[3]; fn=(AF)xv[4]; ztype=xv[5];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
587 ar=AR(a); as=AS(a); at=AT(a); t=at; m=ar?*as:1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
588 wr=AR(w); ws=AS(w); wt=AT(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
589 if(1==ztype)r=wr?wr-1:0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
590 else r=ar?ar-1:0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
591 f1=wr-r;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
592 ASSERT(r<=ar&&0<=f1,EVRANK);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
593 ASSERT(!ICMP(as+ar-r,ws+f1,r),EVLENGTH);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
594 RE(c=prod(f1,ws));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
595 if(mode==ILESS&&(t!=wt||AFLAG(w)&AFNJA+AFREL||n!=aii(w)))R less(w,a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
596 if(!(m&&n&&c&&HOMO(t,wt)&&t>=wt))R indexofsub(mode,a,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
597 switch(ztype){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
598 case 0: GA(z,INT,c, f1, ws); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
599 case 1: GA(z,wt, AN(w),1+r,ws); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
600 case 2: GA(z,B01,c, f1, ws); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
601 case 3: GA(z,B01,1, 0, 0 ); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
602 case 4: GA(z,INT,1, 0, 0 ); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
603 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
604 jt->hin=AN(hi); jt->hiv=AV(hi);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
605 if(t!=wt)RZ(w=cvt(t,w)) else if(t&FL+CMPX)RZ(w=cvt0(w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
606 R fn(jt,mode+IPHOFFSET,m,n,c,k,AR(a),AR(w),(I)1,(I)1,(I)0,(I)0,a,w,&h,z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
607 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
608
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
609 F2(jtindexof){R indexofsub(IIDOT,a,w);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
610 /* a i."r w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
611
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
612 F2(jtjico2){R indexofsub(IICO,a,w);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
613 /* a i:"r w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
614
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
615 F1(jtnubsieve){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
616 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
617 if(SPARSE&AT(w))R nubsievesp(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
618 if(jt->rank)jt->rank[0]=jt->rank[1];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
619 R indexofsub(INUBSV,w,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
620 } /* ~:"r w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
621
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
622 F1(jtnub){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
623 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
624 if(SPARSE&AT(w)||AFLAG(w)&AFNJA+AFREL)R repeat(nubsieve(w),w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
625 R indexofsub(INUB,w,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
626 } /* ~.w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
627
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
628 F2(jtless){A x=w;I ar,at,k,r,*s,wr,*ws,wt;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
629 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
630 at=AT(a); ar=AR(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
631 wt=AT(w); wr=AR(w); r=MAX(1,ar);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
632 if(ar>1+wr)R ca(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
633 if(wr&&r!=wr){RZ(x=gah(r,w)); s=AS(x); ws=AS(w); k=ar>wr?0:1+wr-r; *s=prod(k,ws); ICPY(1+s,k+ws,r-1);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
634 R !(at&SPARSE)&&HOMO(at,wt)&&at==maxtype(at,wt)&&!(AFLAG(a)&AFNJA+AFREL)?indexofsub(ILESS,x,a):
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
635 repeat(not(eps(a,x)),a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
636 } /* a-.w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
637
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
638 F2(jteps){I l,r,rv[2];
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
639 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
640 rv[0]=r=jt->rank?jt->rank[1]:AR(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
641 rv[1]=l=jt->rank?jt->rank[0]:AR(a); jt->rank=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
642 if(SPARSE&AT(a)+AT(w))R lt(irs2(w,a,0L,r,l,jtindexof),sc(r?*(AS(w)+AR(w)-r):1));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
643 jt->rank=rv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
644 R indexofsub(IEPS,w,a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
645 } /* a e."r w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
646
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
647 F1(jtnubind){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
648 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
649 R SPARSE&AT(w)?icap(nubsieve(w)):indexofsub(INUBI,w,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
650 } /* I.@~: w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
651
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
652 F1(jtnubind0){A z;D oldct=jt->ct;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
653 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
654 jt->ct=0.0; z=SPARSE&AT(w)?icap(nubsieve(w)):indexofsub(INUBI,w,w); jt->ct=oldct;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
655 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
656 } /* I.@(~:!.0) w */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
657
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
658
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
659 F1(jtsclass){A e,x,xy,y,z;I c,j,m,n,*v;P*p;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
660 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
661 if(!AR(w))R reshape(v2(1L,1L),one);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
662 n=IC(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
663 RZ(x=indexof(w,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
664 if(DENSE&AT(w))R atab(CEQ,repeat(eq(IX(n),x),x),x);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
665 p=PAV(x); e=SPA(p,e); y=SPA(p,i); RZ(xy=stitch(SPA(p,x),y));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
666 if(n>*AV(e))RZ(xy=over(xy,stitch(e,less(IX(n),y))));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
667 RZ(xy=grade2(xy,xy)); v=AV(xy);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
668 c=*AS(xy);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
669 m=j=-1; DO(c, if(j!=*v){j=*v; ++m;} *v=m; v+=2;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
670 GA(z,SB01,1,2,0); v=AS(z); v[0]=1+m; v[1]=n;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
671 p=PAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
672 SPB(p,a,v2(0L,1L));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
673 SPB(p,e,zero);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
674 SPB(p,i,xy);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
675 SPB(p,x,reshape(sc(c),one));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
676 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
677 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
678
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
679
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
680 #define IOCOLF(f) void f(J jt,I m,I c,I d,A a,A w,A z,A h)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
681 #define IOCOLDECL(T) D tl=1-jt->ct,tr=1/tl,x; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
682 I hj,*hv=AV(h),i,j,jr,l,p=AN(h),*u,*zv=AV(z); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
683 T*av=(T*)AV(a),*v,*wv=(T*)AV(w);UI pm=p
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
684
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
685 #define IOCOLFT(T,f,hasha,hashl,hashr,exp) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
686 IOCOLF(f){IOCOLDECL(T); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
687 for(l=0;l<c;++l){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
688 DO(p, hv[i]=m;); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
689 v=av; DO(m, j=(hasha)%pm; FIND(exp); if(m==hj)hv[j]=i; v+=c;); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
690 v=wv; u=zv; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
691 for(i=0;i<d;++i){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
692 x=*(D*)v; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
693 j=jr=(hashl)%pm; FIND(exp); *u=hj; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
694 j= (hashr)%pm; if(j!=jr){FIND(exp); *u=MIN(*u,hj);} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
695 v+=c; u+=c; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
696 } \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
697 ++av; ++wv; ++zv; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
698 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
699
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
700 #define JOCOLFT(T,f,hasha,hashl,hashr,exp) \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
701 IOCOLF(f){IOCOLDECL(T);I q; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
702 for(l=0;l<c;++l){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
703 DO(p, hv[i]=m;); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
704 v=av+c*(m-1); DQ(m, j=(hasha)%pm; FIND(exp); if(m==hj)hv[j]=i; v-=c;); \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
705 v=wv; u=zv; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
706 for(i=0;i<d;++i){ \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
707 x=*(D*)v; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
708 j=jr=(hashl)%pm; FIND(exp); *u=q=hj; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
709 j= (hashr)%pm; if(j!=jr){FIND(exp); if(m>hj&&(hj>q||q==m))*u=hj;} \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
710 v+=c; u+=c; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
711 } \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
712 ++av; ++wv; ++zv; \
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
713 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
714
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
715 static IOCOLFT(D,jtiocold,hid(*v), hid(tl*x),hid(tr*x),!teq(*v,av[c*hj]))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
716 static IOCOLFT(Z,jtiocolz,hid(*(D*)v),hid(tl*x),hid(tr*x),!zeq(*v,av[c*hj]))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
717
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
718 static JOCOLFT(D,jtjocold,hid(*v), hid(tl*x),hid(tr*x),!teq(*v,av[c*hj]))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
719 static JOCOLFT(Z,jtjocolz,hid(*(D*)v),hid(tl*x),hid(tr*x),!zeq(*v,av[c*hj]))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
720
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
721 A jtiocol(J jt,I mode,A a,A w){A h,z;I ar,at,c,d,m,p,t,wr,*ws,wt;void(*fn)();
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
722 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
723 ASSERT(0!=jt->ct,EVNONCE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
724 at=AT(a); ar=AR(a); m=*AS(a); c=aii(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
725 wt=AT(w); wr=AR(w); ws=AS(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
726 d=1; DO(1+wr-ar, d*=ws[i];);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
727 RE(t=maxtype(at,wt));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
728 if(t!=at)RZ(a=cvt(t,a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
729 if(t!=wt)RZ(w=cvt(t,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
730 p=hsize(m);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
731 GA(h,INT,p,1,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
732 GA(z,INT,AN(w),wr,ws);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
733 switch(t){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
734 default: ASSERT(0,EVNONCE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
735 case FL: fn=mode==IICO?jtjocold:jtiocold; ctmask(jt); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
736 case CMPX: fn=mode==IICO?jtjocolz:jtiocolz; ctmask(jt); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
737 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
738 fn(jt,m,c,d,a,w,z,h);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
739 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
740 } /* a i."1 &.|:w or a i:"1 &.|:w */