Mercurial > hg > jgplsrc

annotate ve.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: Elementary Functions (Arithmetic, etc.) */
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 #include "vasm.h"
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
8
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
9 #define DIVI(u,v) (u||v ? u/(D)v : 0.0)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
10 #define DIVBB(u,v) (v?u:u?inf:0.0)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
11
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
12 #define TYMESBX(u,v) (u?v:0)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
13 #define TYMESXB(u,v) (v?u:0)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
14 #define TYMESID(u,v) (u ?u*v:0)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
15 #define TYMESDI(u,v) ( v?u*v:0)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
16 #define TYMESDD(u,v) (u&&v?u*v:0)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
17
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
18 AOVF( plusII, I,I,I, PLUSVV, PLUS1V, PLUSV1)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
19 AOVF(minusII, I,I,I, MINUSVV,MINUS1V,MINUSV1)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
20 AOVF(tymesII, I,I,I, TYMESVV,TYMES1V,TYMESV1)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
21
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
22 APFX( plusIO, D,I,I, PLUSO)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
23 APFX(minusIO, D,I,I, MINUSO)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
24 APFX(tymesIO, D,I,I, TYMESO)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
25
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
26 AIFX( plusBB, I,B,B, + ) /* plusII */ AIFX( plusBD, D,B,D, + )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
27 /* plusII */ /* plusII */ AIFX( plusID, D,I,D, + )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
28 AIFX( plusDB, D,D,B, + ) AIFX( plusDI, D,D,I, +) ANAN( plusDD, D,D,D, PLUS)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
29 ANAN( plusZZ, Z,Z,Z, zplus )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
30
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
31 AIFX(minusBB, I,B,B, - ) /* minusII */ AIFX(minusBD, D,B,D, - )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
32 /* minusII */ /* minusII */ AIFX(minusID, D,I,D, - )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
33 AIFX(minusDB, D,D,B, - ) AIFX(minusDI, D,D,I, -) ANAN(minusDD, D,D,D, MINUS)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
34 ANAN(minusZZ, Z,Z,Z, zminus)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
35
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
36 /* andBB */ APFX(tymesBI, I,B,I, TYMESBX) APFX(tymesBD, D,B,D, TYMESBX)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
37 APFX(tymesIB, I,I,B, TYMESXB) /* tymesII */ APFX(tymesID, D,I,D, TYMESID)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
38 APFX(tymesDB, D,D,B, TYMESXB) APFX(tymesDI, D,D,I, TYMESDI) APFX(tymesDD, D,D,D, TYMESDD)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
39 ANAN(tymesZZ, Z,Z,Z, ztymes )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
40
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
41 APFX( divBB, D,B,B, DIVBB) APFX( divBI, D,B,I, DIVI) APFX( divBD, D,B,D, DIV)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
42 APFX( divIB, D,I,B, DIVI ) APFX( divII, D,I,I, DIVI) APFX( divID, D,I,D, DIV)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
43 APFX( divDB, D,D,B, DIVI ) APFX( divDI, D,D,I, DIVI) ANAN( divDD, D,D,D, DIV)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
44 ANAN( divZZ, Z,Z,Z, zdiv )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
45
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
46 /* orBB */ APFX( minBI, I,B,I, MIN) APFX( minBD, D,B,D, MIN)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
47 APFX( minIB, I,I,B, MIN) APFX( minII, I,I,I, MIN) APFX( minID, D,I,D, MIN)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
48 APFX( minDB, D,D,B, MIN) APFX( minDI, D,D,I, MIN) APFX( minDD, D,D,D, MIN)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
49 APFX( minSS, SB,SB,SB, SBMIN)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
50
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
51 /* andBB */ APFX( maxBI, I,B,I, MAX) APFX( maxBD, D,B,D, MAX)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
52 APFX( maxIB, I,I,B, MAX) APFX( maxII, I,I,I, MAX) APFX( maxID, D,I,D, MAX)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
53 APFX( maxDB, D,D,B, MAX) APFX( maxDI, D,D,I, MAX) APFX( maxDD, D,D,D, MAX)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
54 APFX( maxSS, SB,SB,SB, SBMAX)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
55
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
56
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
57 static D jtremdd(J jt,D a,D b){D q,x,y;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
58 if(!a)R b;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
59 ASSERT(!INF(b),EVNAN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
60 if(a==inf )R 0<=b?b:a;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
61 if(a==infm)R 0>=b?b:a;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
62 q=b/a; x=tfloor(q); y=tceil(q); R teq(x,y)?0:b-a*x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
63 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
64
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
65 ANAN(remDD, D,D,D, remdd)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
66 ANAN(remZZ, Z,Z,Z, zrem )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
67
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
68 static I jtremid(J jt,I a,D b){D r;I k;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
69 ASSERT(a&&-9e15<b&&b<9e15,EWOV);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
70 r=b-a*floor(b/a); k=(I)r;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
71 ASSERT(k==r,EWOV);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
72 R k;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
73 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
74
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
75 APFX(remID, I,I,D, remid)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
76
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
77 static I remii(I a,I b){I r; R!a?b:(r=b%a,0<a?r+a*(0>r):r+a*(0<r));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
78
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
79 AHDR2(remII,I,I,I){I u,v;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
80 if(1==n) DO(m, *z++=remii(*x,*y); x++; y++; )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
81 else if(b)DO(m, u=*x++; if(0<=u&&!(u&(u-1))){--u; DO(n, *z++=u&*y++;);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
82 else DO(n, *z++=remii( u,*y); y++;))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
83 else DO(m, v=*y++; DO(n, *z++=remii(*x, v); x++; ));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
84 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
85
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
86
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
87 static I igcd1(I a,I b){R a?igcd1(b%a,a):b;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
88
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
89 static I jtigcd(J jt,I a,I b){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
90 if(a>IMIN&&b>IMIN){a=ABS(a); b=ABS(b);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
91 else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
92 if(a==b||!a||!b){jt->jerr=EWOV; R 0;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
93 if(a==IMIN){b=ABS(b); a=-(a+b);}else{a=ABS(a); b=-(a+b);}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
94 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
95 R a?igcd1(b%a,a):b;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
96 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
97
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
98 D jtdgcd(J jt,D a,D b){D a1,b1,t;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
99 a=ABS(a); b=ABS(b); if(a>b){t=a; a=b; b=t;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
100 ASSERT(inf!=b,EVNAN);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
101 if(!a)R b;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
102 a1=a; b1=b;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
103 while(remdd(a1/jfloor(0.5+a1/a),b1)){t=a; a=remdd(a,b); b=t;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
104 R a;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
105 } /* D.L. Forkes 1984; E.E. McDonnell 1992 */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
106 #if SY_64
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
107 #if SY_WIN32
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
108 static I jtilcm(J jt,I a,I b){C er=0;I b1,d,z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
109 if(a&&b){RZ(d=igcd(a,b)); b1=b/d; TYMESVV(1L,&z,&a,&b1); if(er)jt->jerr=EWOV; R z;}else R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
110 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
111 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
112 static I jtilcm(J jt,I a,I b){LD z;I b1,d;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
113 if(a&&b){RZ(d=igcd(a,b)); b1=b/d; z=a*(LD)b1; if(z<IMIN||IMAX<z)jt->jerr=EWOV; R (I)z;}else R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
114 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
115 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
116 #else
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
117 static I jtilcm(J jt,I a,I b){D z;I b1,d;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
118 if(a&&b){RZ(d=igcd(a,b)); b1=b/d; z=a*(D)b1; if(z<IMIN||IMAX<z)jt->jerr=EWOV; R (I)z;}else R 0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
119 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
120 #endif
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
121
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
122 #define GCDIO(u,v) (dgcd((D)u,(D)v))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
123 #define LCMIO(u,v) (dlcm((D)u,(D)v))
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
124
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
125 static D jtdlcm(J jt,D a,D b){ASSERT(!(INF(a)||INF(b)),EVNAN); R a&&b?a*(b/dgcd(a,b)):0;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
126
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
127 APFX(gcdIO, D,I,I, GCDIO)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
128 APFX(gcdII, I,I,I, igcd )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
129 APFX(gcdDD, D,D,D, dgcd )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
130 APFX(gcdZZ, Z,Z,Z, zgcd )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
131
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
132 APFX(lcmII, I,I,I, ilcm )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
133 APFX(lcmIO, D,I,I, LCMIO)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
134 APFX(lcmDD, D,D,D, dlcm )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
135 APFX(lcmZZ, Z,Z,Z, zlcm )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
136
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
137
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
138 #define GETD {d=*wv++; if(!d){z=0; break;}}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
139 #define INTDIVF(c,d) (0>c==0>d?c/d:c%d?c/d-1:c/d)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
140 #define INTDIVC(c,d) (0>c!=0>d?c/d:c%d?c/d+1:c/d)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
141
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
142 F2(jtintdiv){A z;B b,flr;I an,ar,*as,*av,c,d,j,k,m,n,p,p1,r,*s,wn,wr,*ws,*wv,*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
143 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
144 an=AN(a); ar=AR(a); as=AS(a); av=AV(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
145 wn=AN(w); wr=AR(w); ws=AS(w); wv=AV(w); b=ar>=wr; r=b?wr:ar; s=b?as:ws;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
146 ASSERT(!ICMP(as,ws,r),EVLENGTH);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
147 if(an&&wn){m=prod(r,s); n=prod(b?ar-r:wr-r,r+s);}else m=n=0;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
148 GA(z,INT,b?an:wn,b?ar:wr,s); zv=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
149 d=wn?*wv:0; p=0<d?d:-d; p1=d==IMIN?p:p-1; flr=XMFLR==jt->xmode;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
150 if(!wr&&p&&!(p&p1)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
151 k=0; j=1; while(p>j){++k; j<<=1;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
152 switch((0<d?0:2)+(flr?0:1)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
153 case 0: DO(n, *zv++=*av++>>k;); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
154 case 1: DO(n, c=*av++; *zv++=0< c?1+((c-1)>>k):(c+p1)>>k;); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
155 case 2: DO(n, c=*av++; *zv++=c>IMIN?-c>>k:-(-c>>k);); break;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
156 case 3: DO(n, c=*av++; *zv++=0<=c?-(c>>k):1+(-(1+c)>>k););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
157 }}else if(flr){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
158 if(1==n) DO(m, c=*av++; GETD; *zv++=INTDIVF(c,d); )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
159 else if(b)DO(m, GETD; DO(n, c=*av++; *zv++=INTDIVF(c,d););)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
160 else DO(m, c=*av++; DO(n, GETD; *zv++=INTDIVF(c,d););)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
161 }else{
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
162 if(1==n) DO(m, c=*av++; GETD; *zv++=INTDIVC(c,d); )
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
163 else if(b)DO(m, GETD; DO(n, c=*av++; *zv++=INTDIVC(c,d););)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
164 else DO(m, c=*av++; DO(n, GETD; *zv++=INTDIVC(c,d););)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
165 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
166 R z?z:flr?floor1(divide(a,w)):ceil1(divide(a,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
167 } /* <.@% or >.@% on integers */
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
168
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
169
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
170 static F2(jtweight){RZ(a&&w); R df1(behead(over(AR(w)?w:reshape(a,w),one)),bsdot(slash(ds(CSTAR))));}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
171
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
172 F1(jtbase1){A z;B*v;I c,d,m,n,p,r,*s,t,*x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
173 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
174 n=AN(w); t=AT(w); r=AR(w); s=AS(w); c=r?*(s+r-1):1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
175 ASSERT(t&DENSE,EVNONCE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
176 if(c>(SY_64?63:31)||!(t&B01))R pdt(w,weight(sc(c),t&RAT+XNUM?cvt(XNUM,num[2]):num[2]));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
177 if(c)m=n/c; else RE(m=prod(r-1,s));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
178 GA(z,INT,m,r?r-1:0,s); x=m+AV(z); v=n+BAV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
179 if(c)DO(m, p=0; d=1; DO(c, if(*--v)p+=d; d+=d;); *--x=p;)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
180 else memset(x-m,C0,m*SZI);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
181 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
182 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
183
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
184 F2(jtbase2){I ar,*as,at,c,t,wr,*ws,wt;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
185 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
186 at=AT(a); ar=AR(a); as=AS(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
187 wt=AT(w); wr=AR(w); ws=AS(w); c=wr?*(ws+wr-1):1; t=maxtype(at,wt);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
188 ASSERT(at&DENSE&&wt&DENSE,EVNONCE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
189 if(!(t&at))RZ(a=cvt(t,a));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
190 if(!(t&wt))RZ(w=cvt(t,w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
191 R 1>=ar?pdt(w,weight(sc(c),a)):rank2ex(w,rank2ex(sc(c),a,0L,0L,1L,jtweight),0L,1L,1L,jtpdt);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
192 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
193
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
194 F1(jtabase1){A d,z;B*zv;I c,n,p,r,t,*v,x;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
195 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
196 n=AN(w); r=AR(w); t=AT(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
197 ASSERT(t&DENSE,EVNONCE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
198 if(!n||t&B01)R reshape(over(shape(w),n?one:zero),w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
199 if(!(t&INT)){
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
200 d=df2(num[2],maximum(one,aslash(CMAX,mag(ravel(w)))),atop(ds(CFLOOR),ds(CLOG)));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
201 RZ(z=abase2(reshape(increm(d),num[2]),w));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
202 R t&FL&&equ(irs1(z,0L,1L,jthead),lt(w,zero))?irs1(z,0L,1L,jtbehead):z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
203 }
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
204 c=x=0; v=AV(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
205 DO(n, p=*v++; if(p==IMIN){c=SY_64?64:32; break;} x=x<p?p:x<-p?-p:x;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
206 if(!c)while(x){x>>=1; ++c;}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
207 c=MAX(1,c);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
208 GA(z,B01,n*c,1+r,AS(w)); *(r+AS(z))=c;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
209 v=n+AV(w); zv=AN(z)+BAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
210 DO(n, x=*--v; DO(c, *--zv=(B)(x&1); x>>=1;));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
211 R z;
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 F2(jtabase2){A z;I an,ar,at,wn,wr,wt,zn;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
215 RZ(a&&w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
216 an=AN(a); ar=AR(a); at=AT(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
217 wn=AN(w); wr=AR(w); wt=AT(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
218 ASSERT(at&DENSE&&wt&DENSE,EVNONCE);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
219 if(!ar)R residue(a,w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
220 if(1==ar&&at&B01+INT&&wt&B01+INT){I*av,d,r,*u,*wv,x,*zv;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
221 RZ(coerce2(&a,&w,INT));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
222 RE(zn=mult(an,wn)); GA(z,INT,zn,1+wr,AS(w)); *(wr+AS(z))=an;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
223 av=an+AV(a); wv=wn+AV(w); zv=zn+AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
224 if(2==an&&!av[-2]&&0<(d=av[-1])){I d1,j,k;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
225 k=0; j=1; while(d>j){++k; j<<=1;} d1=d-1;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
226 if(d==j)DO(wn, x=*--wv; *--zv=x&d1; *--zv=x>>k;)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
227 else DO(wn, x=*--wv; if(0<=x){*--zv=x%d; *--zv=x/d;}else{*--zv=d+x%d; *--zv=-1+x/d;})
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
228 }else DO(wn, x=*--wv; u=av; DO(an, d=*--u; *--zv=r=remii(d,x); x=d?(x-r)/d:0;););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
229 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
230 }else{PROLOG;A y,*zv;C*u,*yv;I k;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
231 F2RANK(1,0,jtabase2,0);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
232 k=bp(at); u=an*k+CAV(a);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
233 GA(y,at, 1, 0,0); yv=CAV(y);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
234 GA(z,BOX,an,1,0); zv=an+AAV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
235 DO(an, MC(yv,u-=k,k); RZ(w=divide(minus(w,*--zv=residue(y,w)),y)););
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
236 EPILOG(ope(z));
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
237 }}
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
238
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
239 F1(jtintmod2){A z;B*b,*v;I k=SZI,mask,m,n,q,r,*u,*wi;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
240 RZ(w);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
241 n=AN(w); q=n/k; r=n%k; v=BAV(w)+!liln*(k-1);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
242 GA(z,B01,n,AR(w),AS(w)); u=AV(z);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
243 b=(B*)&mask; DO(k, b[i]=1;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
244 b=(B*)&m; DO(q, DO(k, b[i]=*v; v+=k;); *u++=mask&m;)
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
245 b=(B*)u; wi=AV(w)+q*k; DO(r, *b++=1&*wi++?1:0;);
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
246 R z;
Jordi Gutiérrez Hermoso <jordigh@octave.org>
parents:
diff changeset
247 }