1 /*
2 * $Id: ops2.c,v 1.1 2005-09-18 22:03:58 dhmunro Exp $
3 * Implement arithmetic binary operations:
4 *
5 * Add + Subtract - Multiply * Divide / Modulo % Power ^
6 * Greater > Less < GreaterEQ >= LessEQ <= Equal == NotEqual !=
7 */
8 /* Copyright (c) 2005, The Regents of the University of California.
9 * All rights reserved.
10 * This file is part of yorick (http://yorick.sourceforge.net).
11 * Read the accompanying LICENSE file for details.
12 */
13
14 #include "ydata.h"
15 #include "pstdlib.h"
16 #include <string.h>
17
18 #include <errno.h>
19
20 /*--------------------------------------------------------------------------*/
21
22 extern VMaction Power, Multiply, Divide, Modulo, Add, Subtract,
23 ShiftL, ShiftR, Less, Greater, LessEQ, GreaterEQ, Equal, NotEqual;
24
25 /* ..X versions now declared in ydata.h */
26
27 extern StackOp AddII, AddIL, AddID, AddIB,
28 AddLI, AddLL, AddLD, AddLB,
29 AddDI, AddDL, AddDD, AddDB,
30 AddBI, AddBL, AddBD, AddBB;
31 extern BinaryOp AddC, AddS, AddI, AddL,
32 AddF, AddD, AddZ, AddQ;
33
34 extern StackOp SubtractII, SubtractIL, SubtractID, SubtractIB,
35 SubtractLI, SubtractLL, SubtractLD, SubtractLB,
36 SubtractDI, SubtractDL, SubtractDD, SubtractDB,
37 SubtractBI, SubtractBL, SubtractBD, SubtractBB;
38 extern BinaryOp SubtractC, SubtractS, SubtractI, SubtractL,
39 SubtractF, SubtractD, SubtractZ;
40
41 extern StackOp MultiplyII, MultiplyIL, MultiplyID, MultiplyIB,
42 MultiplyLI, MultiplyLL, MultiplyLD, MultiplyLB,
43 MultiplyDI, MultiplyDL, MultiplyDD, MultiplyDB,
44 MultiplyBI, MultiplyBL, MultiplyBD, MultiplyBB;
45 extern BinaryOp MultiplyC, MultiplyS, MultiplyI, MultiplyL,
46 MultiplyF, MultiplyD, MultiplyZ;
47
48 extern StackOp DivideII, DivideIL, DivideID, DivideIB,
49 DivideLI, DivideLL, DivideLD, DivideLB,
50 DivideDI, DivideDL, DivideDD, DivideDB,
51 DivideBI, DivideBL, DivideBD, DivideBB;
52 extern BinaryOp DivideC, DivideS, DivideI, DivideL,
53 DivideF, DivideD, DivideZ;
54
55 extern StackOp ModuloII, ModuloIL, ModuloID, ModuloIB,
56 ModuloLI, ModuloLL, ModuloLD, ModuloLB,
57 ModuloDI, ModuloDL, ModuloDD, ModuloDB,
58 ModuloBI, ModuloBL, ModuloBD, ModuloBB;
59 extern BinaryOp ModuloC, ModuloS, ModuloI, ModuloL,
60 ModuloF, ModuloD, ModuloZ;
61
62 extern StackOp PowerII, PowerIL, PowerID, PowerIB,
63 PowerLI, PowerLL, PowerLD, PowerLB,
64 PowerDI, PowerDL, PowerDD, PowerDB,
65 PowerBI, PowerBL, PowerBD, PowerBB;
66 extern BinaryOp PowerC, PowerS, PowerI, PowerL,
67 PowerF, PowerD, PowerZ;
68
69 extern BinaryOp PowerXF, PowerXD, PowerXZ;
70
71 extern StackOp GreaterII, GreaterIL, GreaterID, GreaterIB,
72 GreaterLI, GreaterLL, GreaterLD, GreaterLB,
73 GreaterDI, GreaterDL, GreaterDD, GreaterDB,
74 GreaterBI, GreaterBL, GreaterBD, GreaterBB;
75 extern BinaryOp GreaterC, GreaterS, GreaterI, GreaterL,
76 GreaterF, GreaterD, GreaterZ, GreaterQ;
77
78 extern StackOp LessII, LessIL, LessID, LessIB,
79 LessLI, LessLL, LessLD, LessLB,
80 LessDI, LessDL, LessDD, LessDB,
81 LessBI, LessBL, LessBD, LessBB;
82
83 extern StackOp GreaterEQII, GreaterEQIL, GreaterEQID, GreaterEQIB,
84 GreaterEQLI, GreaterEQLL, GreaterEQLD, GreaterEQLB,
85 GreaterEQDI, GreaterEQDL, GreaterEQDD, GreaterEQDB,
86 GreaterEQBI, GreaterEQBL, GreaterEQBD, GreaterEQBB;
87 extern BinaryOp GreaterEQC, GreaterEQS, GreaterEQI, GreaterEQL,
88 GreaterEQF, GreaterEQD, GreaterEQZ, GreaterEQQ;
89
90 extern StackOp LessEQII, LessEQIL, LessEQID, LessEQIB,
91 LessEQLI, LessEQLL, LessEQLD, LessEQLB,
92 LessEQDI, LessEQDL, LessEQDD, LessEQDB,
93 LessEQBI, LessEQBL, LessEQBD, LessEQBB;
94
95 extern StackOp EqualII, EqualIL, EqualID, EqualIB,
96 EqualLI, EqualLL, EqualLD, EqualLB,
97 EqualDI, EqualDL, EqualDD, EqualDB,
98 EqualBI, EqualBL, EqualBD, EqualBB;
99 extern BinaryOp EqualC, EqualS, EqualI, EqualL,
100 EqualF, EqualD, EqualZ, EqualQ, EqualP,
101 EqualSI, EqualR;
102
103 extern StackOp NotEqualII, NotEqualIL, NotEqualID, NotEqualIB,
104 NotEqualLI, NotEqualLL, NotEqualLD, NotEqualLB,
105 NotEqualDI, NotEqualDL, NotEqualDD, NotEqualDB,
106 NotEqualBI, NotEqualBL, NotEqualBD, NotEqualBB;
107 extern BinaryOp NotEqualC, NotEqualS, NotEqualI, NotEqualL,
108 NotEqualF, NotEqualD, NotEqualZ, NotEqualQ, NotEqualP,
109 NotEqualSI, NotEqualR;
110
111 /*--------------------------------------------------------------------------*/
112
113 extern Operand *FormOperandIS(Symbol *owner, Operand *op);
114 extern Operand *FormOperandLS(Symbol *owner, Operand *op);
115 extern Operand *FormOperandDS(Symbol *owner, Operand *op);
116 extern Operand *FormOperandDB(Symbol *owner, Operand *op);
117
118 extern void PopToI(Symbol *s);
119 extern void PopToL(Symbol *s);
120 extern void PopToD(Symbol *s);
121
122 extern void *BuildResult2(Operand *l, Operand *r);
123 extern void *BuildResult1(Operand *l, Operand *r);
124 extern void *BuildResult0(Operand *l, Operand *r, StructDef *base);
125
126 extern double fmod(double, double); /* required for real % operands */
127 #define RMOD(x,y) fmod((x),(y))
128 /* could also use x - y*floor(x/y), which differs for negative arguments */
129
130 /* Only one of the power operations is a standard C-library function */
131 extern double pow(double, double); /* pow is double-to-double in math.h */
132 extern long powLL(long, long); /* powLL is long-to-long in nonc.c */
133 extern double powDL(double, long); /* powDL is double-to-long in nonc.c */
134 extern void powZL(double *, double *, long);
135 /* powZL is complex-to-long in nonc.c */
136 extern void powZZ(double *, double *, double *);
137 /* powZZ is complex-to-complex in nonc.c */
138
139 /*--------------------------------------------------------------------------*/
140
141 static Operand lop, rop;
142
143 /*--------------------------------------------------------------------------*/
144 /* Add */
145
Add(void)146 void Add(void) { (sp-1)->ops->Add[sp->ops->id](); }
147
148 static void Add_BB(Operand *l, Operand *r);
149
AddII(void)150 void AddII(void) { Symbol *spr= sp--; sp->value.i+= spr->value.i; }
AddIL(void)151 void AddIL(void) { Symbol *spr= sp--;
152 sp->value.l= sp->value.i+spr->value.l; sp->ops= &longScalar; }
AddID(void)153 void AddID(void) { Symbol *spr= sp--;
154 sp->value.d= sp->value.i+spr->value.d; sp->ops= &doubleScalar; }
AddIB(void)155 void AddIB(void)
156 { Add_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
157
AddLI(void)158 void AddLI(void) { Symbol *spr= sp--; sp->value.l+= spr->value.i; }
AddLL(void)159 void AddLL(void) { Symbol *spr= sp--; sp->value.l+= spr->value.l; }
AddLD(void)160 void AddLD(void) { Symbol *spr= sp--;
161 sp->value.d= sp->value.l+spr->value.d; sp->ops= &doubleScalar; }
AddLB(void)162 void AddLB(void)
163 { Add_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
164
AddDI(void)165 void AddDI(void) { Symbol *spr= sp--; sp->value.d+= spr->value.i; }
AddDL(void)166 void AddDL(void) { Symbol *spr= sp--; sp->value.d+= spr->value.l; }
AddDD(void)167 void AddDD(void) { Symbol *spr= sp--; sp->value.d+= spr->value.d; }
AddDB(void)168 void AddDB(void)
169 { Add_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
170
AddBI(void)171 void AddBI(void)
172 { Add_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
AddBL(void)173 void AddBL(void)
174 { Add_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
AddBD(void)175 void AddBD(void)
176 { Add_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
AddBB(void)177 void AddBB(void)
178 { Add_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
179
Add_BB(Operand * l,Operand * r)180 static void Add_BB(Operand *l, Operand *r)
181 {
182 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
183 if (!ops) YError("bad data type(s) in binary +");
184 ops->Add(l, r);
185 Drop(1);
186 }
187
188 static void AddError(void);
AddError(void)189 static void AddError(void)
190 { YError("operands not conformable in binary +"); }
191
192 #undef OPERATION
193 #define OPERATION(opname, typd, Popper) \
194 void opname(Operand *l, Operand *r) \
195 { typd *dst= BuildResult2(l, r); \
196 if (dst) { \
197 long i, n= l->type.number; \
198 typd *lv= l->value, *rv= r->value; \
199 for (i=0 ; i<n ; i++) dst[i]= lv[i]+rv[i]; \
200 Popper(l->owner); \
201 } else AddError(); }
202
OPERATION(AddC,char,PopTo)203 OPERATION(AddC, char, PopTo)
204 OPERATION(AddS, short, PopTo)
205 OPERATION(AddI, int, PopToI)
206 OPERATION(AddL, long, PopToL)
207 OPERATION(AddF, float, PopTo)
208 OPERATION(AddD, double, PopToD)
209 void AddZ(Operand *l, Operand *r)
210 { double *dst= BuildResult2(l, r);
211 if (dst) {
212 long i, n= 2*l->type.number;
213 double *lv= l->value, *rv= r->value;
214 for (i=0 ; i<n ; i++) dst[i]= lv[i]+rv[i];
215 PopTo(l->owner);
216 } else AddError();
217 }
218
219 /* + also represents string concatenation */
AddQ(Operand * l,Operand * r)220 void AddQ(Operand *l, Operand *r)
221 {
222 char **dst= BuildResult2(l, r);
223 char *tmp;
224 if (dst) {
225 long i, n= l->type.number;
226 char **lv= l->value, **rv= r->value;
227 for (i=0 ; i<n ; i++) {
228 tmp= dst[i]; /* may be lv[i] or rv[i] */
229 dst[i]= p_strncat(lv[i], rv[i], 0);
230 p_free(tmp);
231 }
232 PopTo(l->owner);
233 } else AddError();
234 }
235
AddX(Operand * l,Operand * r)236 void AddX(Operand *l, Operand *r)
237 { YError("non-numeric data type in binary +"); }
238
239 /*--------------------------------------------------------------------------*/
240 /* Subtract */
241
Subtract(void)242 void Subtract(void) { (sp-1)->ops->Subtract[sp->ops->id](); }
243
244 static void Subtract_BB(Operand *l, Operand *r);
245
SubtractII(void)246 void SubtractII(void) { Symbol *spr= sp--; sp->value.i-= spr->value.i; }
SubtractIL(void)247 void SubtractIL(void) { Symbol *spr= sp--;
248 sp->value.l= sp->value.i-spr->value.l; sp->ops= &longScalar; }
SubtractID(void)249 void SubtractID(void) { Symbol *spr= sp--;
250 sp->value.d= sp->value.i-spr->value.d; sp->ops= &doubleScalar; }
SubtractIB(void)251 void SubtractIB(void)
252 { Subtract_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
253
SubtractLI(void)254 void SubtractLI(void) { Symbol *spr= sp--; sp->value.l-= spr->value.i; }
SubtractLL(void)255 void SubtractLL(void) { Symbol *spr= sp--; sp->value.l-= spr->value.l; }
SubtractLD(void)256 void SubtractLD(void) { Symbol *spr= sp--;
257 sp->value.d= sp->value.l-spr->value.d; sp->ops= &doubleScalar; }
SubtractLB(void)258 void SubtractLB(void)
259 { Subtract_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
260
SubtractDI(void)261 void SubtractDI(void) { Symbol *spr= sp--; sp->value.d-= spr->value.i; }
SubtractDL(void)262 void SubtractDL(void) { Symbol *spr= sp--; sp->value.d-= spr->value.l; }
SubtractDD(void)263 void SubtractDD(void) { Symbol *spr= sp--; sp->value.d-= spr->value.d; }
SubtractDB(void)264 void SubtractDB(void)
265 { Subtract_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
266
SubtractBI(void)267 void SubtractBI(void)
268 { Subtract_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
SubtractBL(void)269 void SubtractBL(void)
270 { Subtract_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
SubtractBD(void)271 void SubtractBD(void)
272 { Subtract_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
SubtractBB(void)273 void SubtractBB(void)
274 { Subtract_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
275
Subtract_BB(Operand * l,Operand * r)276 static void Subtract_BB(Operand *l, Operand *r)
277 {
278 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
279 if (!ops) YError("bad data type(s) in binary -");
280 ops->Subtract(l, r);
281 Drop(1);
282 }
283
284 static void SubtractError(void);
SubtractError(void)285 static void SubtractError(void)
286 { YError("operands not conformable in binary -"); }
287
288 #undef OPERATION
289 #define OPERATION(opname, typd, Popper) \
290 void opname(Operand *l, Operand *r) \
291 { typd *dst= BuildResult2(l, r); \
292 if (dst) { \
293 long i, n= l->type.number; \
294 typd *lv= l->value, *rv= r->value; \
295 for (i=0 ; i<n ; i++) dst[i]= lv[i]-rv[i]; \
296 Popper(l->owner); \
297 } else SubtractError(); }
298
OPERATION(SubtractC,char,PopTo)299 OPERATION(SubtractC, char, PopTo)
300 OPERATION(SubtractS, short, PopTo)
301 OPERATION(SubtractI, int, PopToI)
302 OPERATION(SubtractL, long, PopToL)
303 OPERATION(SubtractF, float, PopTo)
304 OPERATION(SubtractD, double, PopToD)
305 void SubtractZ(Operand *l, Operand *r)
306 { double *dst= BuildResult2(l, r);
307 if (dst) {
308 long i, n= 2*l->type.number;
309 double *lv= l->value, *rv= r->value;
310 for (i=0 ; i<n ; i++) dst[i]= lv[i]-rv[i];
311 PopTo(l->owner);
312 } else SubtractError();
313 }
314
SubtractX(Operand * l,Operand * r)315 void SubtractX(Operand *l, Operand *r)
316 { YError("non-numeric data type in binary -"); }
317
318 /*--------------------------------------------------------------------------*/
319 /* Multiply */
320
Multiply(void)321 void Multiply(void) { (sp-1)->ops->Multiply[sp->ops->id](); }
322
323 static void Multiply_BB(Operand *l, Operand *r);
324
MultiplyII(void)325 void MultiplyII(void) { Symbol *spr= sp--; sp->value.i*= spr->value.i; }
MultiplyIL(void)326 void MultiplyIL(void) { Symbol *spr= sp--;
327 sp->value.l= sp->value.i*spr->value.l; sp->ops= &longScalar; }
MultiplyID(void)328 void MultiplyID(void) { Symbol *spr= sp--;
329 sp->value.d= sp->value.i*spr->value.d; sp->ops= &doubleScalar; }
MultiplyIB(void)330 void MultiplyIB(void)
331 { Multiply_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
332
MultiplyLI(void)333 void MultiplyLI(void) { Symbol *spr= sp--; sp->value.l*= spr->value.i; }
MultiplyLL(void)334 void MultiplyLL(void) { Symbol *spr= sp--; sp->value.l*= spr->value.l; }
MultiplyLD(void)335 void MultiplyLD(void) { Symbol *spr= sp--;
336 sp->value.d= sp->value.l*spr->value.d; sp->ops= &doubleScalar; }
MultiplyLB(void)337 void MultiplyLB(void)
338 { Multiply_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
339
MultiplyDI(void)340 void MultiplyDI(void) { Symbol *spr= sp--; sp->value.d*= spr->value.i; }
MultiplyDL(void)341 void MultiplyDL(void) { Symbol *spr= sp--; sp->value.d*= spr->value.l; }
MultiplyDD(void)342 void MultiplyDD(void) { Symbol *spr= sp--; sp->value.d*= spr->value.d; }
MultiplyDB(void)343 void MultiplyDB(void)
344 { Multiply_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
345
MultiplyBI(void)346 void MultiplyBI(void)
347 { Multiply_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
MultiplyBL(void)348 void MultiplyBL(void)
349 { Multiply_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
MultiplyBD(void)350 void MultiplyBD(void)
351 { Multiply_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
MultiplyBB(void)352 void MultiplyBB(void)
353 { Multiply_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
354
Multiply_BB(Operand * l,Operand * r)355 static void Multiply_BB(Operand *l, Operand *r)
356 {
357 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
358 if (!ops) YError("bad data type(s) in binary *");
359 ops->Multiply(l, r);
360 Drop(1);
361 }
362
363 static void MultiplyError(void);
MultiplyError(void)364 static void MultiplyError(void)
365 { YError("operands not conformable in binary *"); }
366
367 #undef OPERATION
368 #define OPERATION(opname, typd, Popper) \
369 void opname(Operand *l, Operand *r) \
370 { typd *dst= BuildResult2(l, r); \
371 if (dst) { \
372 long i, n= l->type.number; \
373 typd *lv= l->value, *rv= r->value; \
374 for (i=0 ; i<n ; i++) dst[i]= lv[i]*rv[i]; \
375 Popper(l->owner); \
376 } else MultiplyError(); }
377
OPERATION(MultiplyC,char,PopTo)378 OPERATION(MultiplyC, char, PopTo)
379 OPERATION(MultiplyS, short, PopTo)
380 OPERATION(MultiplyI, int, PopToI)
381 OPERATION(MultiplyL, long, PopToL)
382 OPERATION(MultiplyF, float, PopTo)
383 OPERATION(MultiplyD, double, PopToD)
384 void MultiplyZ(Operand *l, Operand *r)
385 { double *dst= BuildResult2(l, r);
386 if (dst) {
387 long i, n= l->type.number;
388 double *lv= l->value, *rv= r->value;
389 double lr, li, rr, ri; /* watch out for dst==lv or rv */
390 for (i=0 ; i<n ; i++) {
391 lr= lv[2*i]; li= lv[2*i+1];
392 rr= rv[2*i]; ri= rv[2*i+1];
393 dst[2*i]= lr*rr-li*ri; dst[2*i+1]= lr*ri+li*rr;
394 }
395 PopTo(l->owner);
396 } else MultiplyError();
397 }
398
MultiplyX(Operand * l,Operand * r)399 void MultiplyX(Operand *l, Operand *r)
400 { YError("non-numeric data type in binary *"); }
401
402 /*--------------------------------------------------------------------------*/
403 /* Divide */
404
Divide(void)405 void Divide(void) { (sp-1)->ops->Divide[sp->ops->id](); }
406
407 static void Divide_BB(Operand *l, Operand *r);
408
DivideII(void)409 void DivideII(void) { Symbol *spr= sp--; sp->value.i/= spr->value.i; }
DivideIL(void)410 void DivideIL(void) { Symbol *spr= sp--;
411 sp->value.l= sp->value.i/spr->value.l; sp->ops= &longScalar; }
DivideID(void)412 void DivideID(void) { Symbol *spr= sp--;
413 sp->value.d= sp->value.i/spr->value.d; sp->ops= &doubleScalar; }
DivideIB(void)414 void DivideIB(void)
415 { Divide_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
416
DivideLI(void)417 void DivideLI(void) { Symbol *spr= sp--; sp->value.l/= spr->value.i; }
DivideLL(void)418 void DivideLL(void) { Symbol *spr= sp--; sp->value.l/= spr->value.l; }
DivideLD(void)419 void DivideLD(void) { Symbol *spr= sp--;
420 sp->value.d= sp->value.l/spr->value.d; sp->ops= &doubleScalar; }
DivideLB(void)421 void DivideLB(void)
422 { Divide_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
423
DivideDI(void)424 void DivideDI(void) { Symbol *spr= sp--; sp->value.d/= spr->value.i; }
DivideDL(void)425 void DivideDL(void) { Symbol *spr= sp--; sp->value.d/= spr->value.l; }
DivideDD(void)426 void DivideDD(void) { Symbol *spr= sp--; sp->value.d/= spr->value.d; }
DivideDB(void)427 void DivideDB(void)
428 { Divide_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
429
DivideBI(void)430 void DivideBI(void)
431 { Divide_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
DivideBL(void)432 void DivideBL(void)
433 { Divide_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
DivideBD(void)434 void DivideBD(void)
435 { Divide_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
DivideBB(void)436 void DivideBB(void)
437 { Divide_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
438
Divide_BB(Operand * l,Operand * r)439 static void Divide_BB(Operand *l, Operand *r)
440 {
441 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
442 if (!ops) YError("bad data type(s) in binary /");
443 ops->Divide(l, r);
444 Drop(1);
445 }
446
447 static void DivideError(void);
DivideError(void)448 static void DivideError(void)
449 { YError("operands not conformable in binary /"); }
450
451 #undef OPERATION
452 #define OPERATION(opname, typd, Popper) \
453 void opname(Operand *l, Operand *r) \
454 { typd *dst= BuildResult2(l, r); \
455 if (dst) { \
456 long i, n= l->type.number; \
457 typd *lv= l->value, *rv= r->value; \
458 for (i=0 ; i<n ; i++) dst[i]= lv[i]/rv[i]; \
459 Popper(l->owner); \
460 } else DivideError(); }
461
OPERATION(DivideC,unsigned char,PopTo)462 OPERATION(DivideC, unsigned char, PopTo)
463 OPERATION(DivideS, short, PopTo)
464 OPERATION(DivideI, int, PopToI)
465 OPERATION(DivideL, long, PopToL)
466 OPERATION(DivideF, float, PopTo)
467 OPERATION(DivideD, double, PopToD)
468 void DivideZ(Operand *l, Operand *r)
469 { double *dst= BuildResult2(l, r);
470 if (dst) {
471 long i, n = l->type.number;
472 double *lv = l->value, *rv= r->value;
473 double lr, li, rr, ri; /* watch out for dst==lv or rv */
474 for (i=0 ; i<n ; i++) {
475 lr = lv[2*i]; li = lv[2*i+1];
476 rr = rv[2*i]; ri = rv[2*i+1];
477 if ((rr>0?rr:-rr)>(ri>0?ri:-ri)) { /* be careful about overflow... */
478 ri/=rr; rr=1.0/((1.0+ri*ri)*rr);
479 dst[2*i] = (lr+li*ri)*rr;
480 dst[2*i+1] = (li-lr*ri)*rr;
481 } else {
482 rr/=ri; ri=1.0/((1.0+rr*rr)*ri);
483 dst[2*i] = (lr*rr+li)*ri;
484 dst[2*i+1] = (li*rr-lr)*ri;
485 }
486 }
487 PopTo(l->owner);
488 } else DivideError();
489 }
490
DivideX(Operand * l,Operand * r)491 void DivideX(Operand *l, Operand *r)
492 { YError("non-numeric data type in binary /"); }
493
494 /*--------------------------------------------------------------------------*/
495 /* Modulo */
496
Modulo(void)497 void Modulo(void) { (sp-1)->ops->Modulo[sp->ops->id](); }
498
499 static void Modulo_BB(Operand *l, Operand *r);
500
ModuloII(void)501 void ModuloII(void) { Symbol *spr= sp--; sp->value.i%= spr->value.i; }
ModuloIL(void)502 void ModuloIL(void) { Symbol *spr= sp--;
503 sp->value.l= sp->value.i%spr->value.l; sp->ops= &longScalar; }
ModuloID(void)504 void ModuloID(void) { Symbol *spr= sp--;
505 sp->value.d= RMOD(sp->value.i,spr->value.d); sp->ops= &doubleScalar; }
ModuloIB(void)506 void ModuloIB(void)
507 { Modulo_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
508
ModuloLI(void)509 void ModuloLI(void) { Symbol *spr= sp--; sp->value.l%= spr->value.i; }
ModuloLL(void)510 void ModuloLL(void) { Symbol *spr= sp--; sp->value.l%= spr->value.l; }
ModuloLD(void)511 void ModuloLD(void) { Symbol *spr= sp--;
512 sp->value.d= RMOD(sp->value.l,spr->value.d); sp->ops= &doubleScalar; }
ModuloLB(void)513 void ModuloLB(void)
514 { Modulo_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
515
ModuloDI(void)516 void ModuloDI(void) { Symbol *spr= sp--;
517 sp->value.d= RMOD(sp->value.d, spr->value.i); }
ModuloDL(void)518 void ModuloDL(void) { Symbol *spr= sp--;
519 sp->value.d= RMOD(sp->value.d, spr->value.l); }
ModuloDD(void)520 void ModuloDD(void) { Symbol *spr= sp--;
521 sp->value.d= RMOD(sp->value.d, spr->value.d); }
ModuloDB(void)522 void ModuloDB(void)
523 { Modulo_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
524
ModuloBI(void)525 void ModuloBI(void)
526 { Modulo_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
ModuloBL(void)527 void ModuloBL(void)
528 { Modulo_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
ModuloBD(void)529 void ModuloBD(void)
530 { Modulo_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
ModuloBB(void)531 void ModuloBB(void)
532 { Modulo_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
533
Modulo_BB(Operand * l,Operand * r)534 static void Modulo_BB(Operand *l, Operand *r)
535 {
536 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
537 if (!ops) YError("bad data type(s) in binary %");
538 ops->Modulo(l, r);
539 Drop(1);
540 }
541
542 static void ModuloError(void);
ModuloError(void)543 static void ModuloError(void)
544 { YError("operands not conformable in binary %"); }
545
546 #undef OPERATION
547 #define OPERATION(opname, typd, Popper) \
548 void opname(Operand *l, Operand *r) \
549 { typd *dst= BuildResult2(l, r); \
550 if (dst) { \
551 long i, n= l->type.number; \
552 typd *lv= l->value, *rv= r->value; \
553 for (i=0 ; i<n ; i++) dst[i]= lv[i]%rv[i]; \
554 Popper(l->owner); \
555 } else ModuloError(); }
556
OPERATION(ModuloC,unsigned char,PopTo)557 OPERATION(ModuloC, unsigned char, PopTo)
558 OPERATION(ModuloS, short, PopTo)
559 OPERATION(ModuloI, int, PopToI)
560 OPERATION(ModuloL, long, PopToL)
561
562 #undef OPERATION
563 #define OPERATION(opname, typd, Popper) \
564 void opname(Operand *l, Operand *r) \
565 { typd *dst= BuildResult2(l, r); \
566 if (dst) { \
567 long i, n= l->type.number; \
568 typd *lv= l->value, *rv= r->value; \
569 for (i=0 ; i<n ; i++) dst[i]= (typd)RMOD(lv[i],rv[i]); \
570 Popper(l->owner); \
571 } else ModuloError(); }
572
573 OPERATION(ModuloF, float, PopTo)
574 OPERATION(ModuloD, double, PopToD)
575 void ModuloZ(Operand *l, Operand *r)
576 { YError("complex operand not allowed in binary %"); }
577
ModuloX(Operand * l,Operand * r)578 void ModuloX(Operand *l, Operand *r)
579 { YError("non-numeric data type in binary %"); }
580
581 /*--------------------------------------------------------------------------*/
582 /* Power -- really two operations:
583 raising to integer power leaves data type of left operand unchanged
584 raising to real or complex power follows ordinary binary promotion
585 rules
586 */
587
Power(void)588 void Power(void) { (sp-1)->ops->Power[sp->ops->id](); }
589
590 static void Power_BB(Operand *l, Operand *r);
591
PowerII(void)592 void PowerII(void) { Symbol *spr= sp--;
593 sp->value.i= powLL(sp->value.i, spr->value.i); }
PowerIL(void)594 void PowerIL(void) { Symbol *spr= sp--;
595 sp->value.l= powLL(sp->value.i, spr->value.l); sp->ops= &longScalar; }
PowerID(void)596 void PowerID(void) {
597 Symbol *spr= sp--;
598 errno = 0;
599 sp->value.d= pow(sp->value.i, spr->value.d);
600 if (errno) {
601 if (errno!=ERANGE || sp->value.d!=0.)
602 YError("mathlib pow() function signals error");
603 }
604 sp->ops= &doubleScalar;
605 }
PowerIB(void)606 void PowerIB(void)
607 { Power_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
608
PowerLI(void)609 void PowerLI(void) { Symbol *spr= sp--;
610 sp->value.l= powLL(sp->value.l, spr->value.i); }
PowerLL(void)611 void PowerLL(void) { Symbol *spr= sp--;
612 sp->value.l= powLL(sp->value.l, spr->value.l); }
PowerLD(void)613 void PowerLD(void) {
614 Symbol *spr= sp--;
615 errno = 0;
616 sp->value.d= pow(sp->value.l, spr->value.d);
617 if (errno) {
618 if (errno!=ERANGE || sp->value.d!=0.)
619 YError("mathlib pow() function signals error");
620 }
621 sp->ops= &doubleScalar;
622 }
PowerLB(void)623 void PowerLB(void)
624 { Power_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
625
PowerDI(void)626 void PowerDI(void) { Symbol *spr= sp--;
627 sp->value.d= powDL(sp->value.d, spr->value.i); }
PowerDL(void)628 void PowerDL(void) { Symbol *spr= sp--;
629 sp->value.d= powDL(sp->value.d, spr->value.l); }
PowerDD(void)630 void PowerDD(void) {
631 Symbol *spr= sp--;
632 errno = 0;
633 sp->value.d= pow(sp->value.d, spr->value.d);
634 if (errno) {
635 if (errno!=ERANGE || sp->value.d!=0.)
636 YError("mathlib pow() function signals error");
637 }
638 }
PowerDB(void)639 void PowerDB(void)
640 { Power_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
641
PowerBI(void)642 void PowerBI(void)
643 { Power_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
PowerBL(void)644 void PowerBL(void)
645 { Power_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
PowerBD(void)646 void PowerBD(void)
647 { Power_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
PowerBB(void)648 void PowerBB(void)
649 { Power_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
650
Power_BB(Operand * l,Operand * r)651 static void Power_BB(Operand *l, Operand *r)
652 {
653 int promoteID= r->ops->promoteID;
654 if (promoteID<T_FLOAT && l->ops->promoteID<=T_COMPLEX) {
655 /* raising to integer power does not change type of left operand,
656 but right operand must always be long */
657 r->ops->ToLong(r);
658 l->ops->Power(l, r);
659 } else {
660 /* raising to non-integer power follows same promotion rules as
661 all other arithmetic binary operators (only 3 possibilities) */
662 Operations *ops= l->ops->Promote[promoteID](l, r);
663 if (!ops) YError("bad data type(s) in binary ^");
664 if (ops==&floatOps) PowerXF(l, r);
665 else if (ops==&doubleOps) PowerXD(l, r);
666 else if (ops==&complexOps) PowerXZ(l, r);
667 else YError("bad data type(s) in binary ^");
668 }
669 Drop(1);
670 }
671
672 static void PowerError(void);
PowerError(void)673 static void PowerError(void)
674 { YError("operands not conformable in binary ^"); }
675
676 #undef OPERATION
677 #define OPERATION(opname, typd, Popper) \
678 void opname(Operand *l, Operand *r) \
679 { typd *dst= BuildResult1(l, r); \
680 if (dst) { \
681 long i, n= l->type.number; \
682 typd *lv= l->value; long *rv= r->value; \
683 for (i=0 ; i<n ; i++) dst[i]= (typd)powLL(lv[i], rv[i]); \
684 Popper(l->owner); \
685 } else PowerError(); }
686
OPERATION(PowerC,char,PopTo)687 OPERATION(PowerC, char, PopTo)
688 OPERATION(PowerS, short, PopTo)
689 OPERATION(PowerI, int, PopToI)
690 OPERATION(PowerL, long, PopToL)
691
692 #undef OPERATION
693 #define OPERATION(opname, typd, Popper) \
694 void opname(Operand *l, Operand *r) \
695 { typd *dst= BuildResult1(l, r); \
696 if (dst) { \
697 long i, n= l->type.number; \
698 typd *lv= l->value; long *rv= r->value; \
699 for (i=0 ; i<n ; i++) dst[i]= (typd)powDL(lv[i], rv[i]); \
700 Popper(l->owner); \
701 } else PowerError(); }
702
703 OPERATION(PowerF, float, PopTo)
704 OPERATION(PowerD, double, PopToD)
705 void PowerZ(Operand *l, Operand *r)
706 { double *dst= BuildResult1(l, r);
707 if (dst) {
708 long i, n= l->type.number;
709 double *lv= l->value; long *rv= r->value;
710 for (i=0 ; i<n ; i++) powZL(&dst[2*i], &lv[2*i], rv[i]);
711 PopTo(l->owner);
712 } else PowerError();
713 }
714
715 #undef OPERATION
716 #define OPERATION(opname, typd, Popper) \
717 void opname(Operand *l, Operand *r) \
718 { typd *dst= BuildResult2(l, r); \
719 if (dst) { \
720 long i, n= l->type.number; \
721 typd *lv= l->value, *rv= r->value; \
722 for (i=0,errno=0 ; i<n ; i++) { dst[i]= (typd)pow(lv[i], rv[i]); \
723 if (errno) { if (errno==ERANGE && !dst[i]) errno=0; \
724 else YError("mathlib pow() function signals error"); }} \
725 Popper(l->owner); \
726 } else PowerError(); }
727
OPERATION(PowerXF,float,PopTo)728 OPERATION(PowerXF, float, PopTo)
729 OPERATION(PowerXD, double, PopToD)
730 void PowerXZ(Operand *l, Operand *r)
731 { double *dst= BuildResult2(l, r);
732 if (dst) {
733 long i, n= 2*l->type.number;
734 double *lv= l->value, *rv= r->value;
735 for (i=0,errno=0 ; i<n && !errno ; i+=2) powZZ(&dst[i], &lv[i], &rv[i]);
736 if (errno) YError("mathlib error in complex^complex");
737 PopTo(l->owner);
738 } else PowerError();
739 }
740
PowerX(Operand * l,Operand * r)741 void PowerX(Operand *l, Operand *r)
742 { YError("non-numeric data type in binary ^"); }
743
744 /*--------------------------------------------------------------------------*/
745 /* Greater */
746
Greater(void)747 void Greater(void) { (sp-1)->ops->Greater[sp->ops->id](); }
748
749 static void Greater_BB(Operand *l, Operand *r);
750
GreaterII(void)751 void GreaterII(void) { Symbol *spr= sp--;
752 sp->value.i= (sp->value.i>spr->value.i); }
GreaterIL(void)753 void GreaterIL(void) { Symbol *spr= sp--;
754 sp->value.i= (sp->value.i>spr->value.l); }
GreaterID(void)755 void GreaterID(void) { Symbol *spr= sp--;
756 sp->value.i= (sp->value.i>spr->value.d); }
GreaterIB(void)757 void GreaterIB(void)
758 { Greater_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
759
GreaterLI(void)760 void GreaterLI(void) { Symbol *spr= sp--;
761 sp->value.i= (sp->value.l>spr->value.i); sp->ops= &intScalar; }
GreaterLL(void)762 void GreaterLL(void) { Symbol *spr= sp--;
763 sp->value.i= (sp->value.l>spr->value.l); sp->ops= &intScalar; }
GreaterLD(void)764 void GreaterLD(void) { Symbol *spr= sp--;
765 sp->value.i= (sp->value.l>spr->value.d); sp->ops= &intScalar; }
GreaterLB(void)766 void GreaterLB(void)
767 { Greater_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
768
GreaterDI(void)769 void GreaterDI(void) { Symbol *spr= sp--;
770 sp->value.i= (sp->value.d>spr->value.i); sp->ops= &intScalar; }
GreaterDL(void)771 void GreaterDL(void) { Symbol *spr= sp--;
772 sp->value.i= (sp->value.d>spr->value.l); sp->ops= &intScalar; }
GreaterDD(void)773 void GreaterDD(void) { Symbol *spr= sp--;
774 sp->value.i= (sp->value.d>spr->value.d); sp->ops= &intScalar; }
GreaterDB(void)775 void GreaterDB(void)
776 { Greater_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
777
GreaterBI(void)778 void GreaterBI(void)
779 { Greater_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
GreaterBL(void)780 void GreaterBL(void)
781 { Greater_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
GreaterBD(void)782 void GreaterBD(void)
783 { Greater_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
GreaterBB(void)784 void GreaterBB(void)
785 { Greater_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
786
Greater_BB(Operand * l,Operand * r)787 static void Greater_BB(Operand *l, Operand *r)
788 {
789 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
790 if (!ops) YError("bad data type(s) in binary >");
791 ops->Greater(l, r);
792 Drop(1);
793 }
794
795 static void GreaterError(void);
GreaterError(void)796 static void GreaterError(void)
797 { YError("operands not conformable in binary > or <"); }
798
799 #undef OPERATION
800 #define OPERATION(opname, typd) \
801 void opname(Operand *l, Operand *r) \
802 { int *dst= BuildResult0(l, r, &intStruct); \
803 if (dst) { \
804 long i, n= l->type.number; \
805 typd *lv= l->value, *rv= r->value; \
806 for (i=0 ; i<n ; i++) dst[i]= lv[i]>rv[i]; \
807 PopToI(l->owner); \
808 } else GreaterError(); }
809
OPERATION(GreaterC,unsigned char)810 OPERATION(GreaterC, unsigned char)
811 OPERATION(GreaterS, short)
812 OPERATION(GreaterI, int)
813 OPERATION(GreaterL, long)
814 OPERATION(GreaterF, float)
815 OPERATION(GreaterD, double)
816 void GreaterZ(Operand *l, Operand *r)
817 { YError("complex operand not allowed in binary > or <"); }
818
GreaterQ(Operand * l,Operand * r)819 void GreaterQ(Operand *l, Operand *r)
820 {
821 int *dst= BuildResult0(l, r, &intStruct);
822 if (dst) {
823 long i, n= l->type.number;
824 char **lv= l->value, **rv= r->value, *ls, *rs;
825 for (i=0 ; i<n ; i++) {
826 ls= lv[i]; rs= rv[i];
827 if (ls && rs) dst[i]= strcmp(ls, rs)>0;
828 else dst[i]= (ls && !rs);
829 }
830 PopTo(l->owner);
831 } else GreaterError();
832 }
833
GreaterX(Operand * l,Operand * r)834 void GreaterX(Operand *l, Operand *r)
835 { YError("non-numeric data type in binary > or <"); }
836
837 /*--------------------------------------------------------------------------*/
838 /* Less */
839
Less(void)840 void Less(void) { (sp-1)->ops->Less[sp->ops->id](); }
841
842 static void Less_BB(Operand *l, Operand *r);
843
LessII(void)844 void LessII(void) { Symbol *spr= sp--;
845 sp->value.i= (sp->value.i<spr->value.i); }
LessIL(void)846 void LessIL(void) { Symbol *spr= sp--;
847 sp->value.i= (sp->value.i<spr->value.l); }
LessID(void)848 void LessID(void) { Symbol *spr= sp--;
849 sp->value.i= (sp->value.i<spr->value.d); }
LessIB(void)850 void LessIB(void)
851 { Less_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
852
LessLI(void)853 void LessLI(void) { Symbol *spr= sp--;
854 sp->value.i= (sp->value.l<spr->value.i); sp->ops= &intScalar; }
LessLL(void)855 void LessLL(void) { Symbol *spr= sp--;
856 sp->value.i= (sp->value.l<spr->value.l); sp->ops= &intScalar; }
LessLD(void)857 void LessLD(void) { Symbol *spr= sp--;
858 sp->value.i= (sp->value.l<spr->value.d); sp->ops= &intScalar; }
LessLB(void)859 void LessLB(void)
860 { Less_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
861
LessDI(void)862 void LessDI(void) { Symbol *spr= sp--;
863 sp->value.i= (sp->value.d<spr->value.i); sp->ops= &intScalar; }
LessDL(void)864 void LessDL(void) { Symbol *spr= sp--;
865 sp->value.i= (sp->value.d<spr->value.l); sp->ops= &intScalar; }
LessDD(void)866 void LessDD(void) { Symbol *spr= sp--;
867 sp->value.i= (sp->value.d<spr->value.d); sp->ops= &intScalar; }
LessDB(void)868 void LessDB(void)
869 { Less_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
870
LessBI(void)871 void LessBI(void)
872 { Less_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
LessBL(void)873 void LessBL(void)
874 { Less_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
LessBD(void)875 void LessBD(void)
876 { Less_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
LessBB(void)877 void LessBB(void)
878 { Less_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
879
Less_BB(Operand * l,Operand * r)880 static void Less_BB(Operand *l, Operand *r)
881 {
882 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
883 if (!ops) YError("bad data type(s) in binary <");
884 ops->Greater(r, l);
885 PopTo(sp-1); /* instead of Drop(1), since args reversed */
886 }
887
888 /*--------------------------------------------------------------------------*/
889 /* GreaterEQ */
890
GreaterEQ(void)891 void GreaterEQ(void) { (sp-1)->ops->GreaterEQ[sp->ops->id](); }
892
893 static void GreaterEQ_BB(Operand *l, Operand *r);
894
GreaterEQII(void)895 void GreaterEQII(void) { Symbol *spr= sp--;
896 sp->value.i= (sp->value.i>=spr->value.i); }
GreaterEQIL(void)897 void GreaterEQIL(void) { Symbol *spr= sp--;
898 sp->value.i= (sp->value.i>=spr->value.l); }
GreaterEQID(void)899 void GreaterEQID(void) { Symbol *spr= sp--;
900 sp->value.i= (sp->value.i>=spr->value.d); }
GreaterEQIB(void)901 void GreaterEQIB(void)
902 { GreaterEQ_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
903
GreaterEQLI(void)904 void GreaterEQLI(void) { Symbol *spr= sp--;
905 sp->value.i= (sp->value.l>=spr->value.i); sp->ops= &intScalar; }
GreaterEQLL(void)906 void GreaterEQLL(void) { Symbol *spr= sp--;
907 sp->value.i= (sp->value.l>=spr->value.l); sp->ops= &intScalar; }
GreaterEQLD(void)908 void GreaterEQLD(void) { Symbol *spr= sp--;
909 sp->value.i= (sp->value.l>=spr->value.d); sp->ops= &intScalar; }
GreaterEQLB(void)910 void GreaterEQLB(void)
911 { GreaterEQ_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
912
GreaterEQDI(void)913 void GreaterEQDI(void) { Symbol *spr= sp--;
914 sp->value.i= (sp->value.d>=spr->value.i); sp->ops= &intScalar; }
GreaterEQDL(void)915 void GreaterEQDL(void) { Symbol *spr= sp--;
916 sp->value.i= (sp->value.d>=spr->value.l); sp->ops= &intScalar; }
GreaterEQDD(void)917 void GreaterEQDD(void) { Symbol *spr= sp--;
918 sp->value.i= (sp->value.d>=spr->value.d); sp->ops= &intScalar; }
GreaterEQDB(void)919 void GreaterEQDB(void)
920 { GreaterEQ_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
921
GreaterEQBI(void)922 void GreaterEQBI(void)
923 { GreaterEQ_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
GreaterEQBL(void)924 void GreaterEQBL(void)
925 { GreaterEQ_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
GreaterEQBD(void)926 void GreaterEQBD(void)
927 { GreaterEQ_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
GreaterEQBB(void)928 void GreaterEQBB(void)
929 { GreaterEQ_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
930
GreaterEQ_BB(Operand * l,Operand * r)931 static void GreaterEQ_BB(Operand *l, Operand *r)
932 {
933 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
934 if (!ops) YError("bad data type(s) in binary >=");
935 ops->GreaterEQ(l, r);
936 Drop(1);
937 }
938
939 static void GreaterEQError(void);
GreaterEQError(void)940 static void GreaterEQError(void)
941 { YError("operands not conformable in binary >= or <="); }
942
943 #undef OPERATION
944 #define OPERATION(opname, typd) \
945 void opname(Operand *l, Operand *r) \
946 { int *dst= BuildResult0(l, r, &intStruct); \
947 if (dst) { \
948 long i, n= l->type.number; \
949 typd *lv= l->value, *rv= r->value; \
950 for (i=0 ; i<n ; i++) dst[i]= lv[i]>=rv[i]; \
951 PopToI(l->owner); \
952 } else GreaterEQError(); }
953
OPERATION(GreaterEQC,unsigned char)954 OPERATION(GreaterEQC, unsigned char)
955 OPERATION(GreaterEQS, short)
956 OPERATION(GreaterEQI, int)
957 OPERATION(GreaterEQL, long)
958 OPERATION(GreaterEQF, float)
959 OPERATION(GreaterEQD, double)
960 void GreaterEQZ(Operand *l, Operand *r)
961 { YError("complex operand not allowed in binary >= or <="); }
962
GreaterEQQ(Operand * l,Operand * r)963 void GreaterEQQ(Operand *l, Operand *r)
964 {
965 int *dst= BuildResult0(l, r, &intStruct);
966 if (dst) {
967 long i, n= l->type.number;
968 char **lv= l->value, **rv= r->value, *ls, *rs;
969 for (i=0 ; i<n ; i++) {
970 ls= lv[i]; rs= rv[i];
971 if (ls && rs) dst[i]= strcmp(ls, rs)>=0;
972 else dst[i]= (ls && !rs);
973 }
974 PopTo(l->owner);
975 } else GreaterEQError();
976 }
977
GreaterEQX(Operand * l,Operand * r)978 void GreaterEQX(Operand *l, Operand *r)
979 { YError("non-numeric data type in binary >= or <="); }
980
981 /*--------------------------------------------------------------------------*/
982 /* LessEQ */
983
LessEQ(void)984 void LessEQ(void) { (sp-1)->ops->LessEQ[sp->ops->id](); }
985
986 static void LessEQ_BB(Operand *l, Operand *r);
987
LessEQII(void)988 void LessEQII(void) { Symbol *spr= sp--;
989 sp->value.i= (sp->value.i<=spr->value.i); }
LessEQIL(void)990 void LessEQIL(void) { Symbol *spr= sp--;
991 sp->value.i= (sp->value.i<=spr->value.l); }
LessEQID(void)992 void LessEQID(void) { Symbol *spr= sp--;
993 sp->value.i= (sp->value.i<=spr->value.d); }
LessEQIB(void)994 void LessEQIB(void)
995 { LessEQ_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
996
LessEQLI(void)997 void LessEQLI(void) { Symbol *spr= sp--;
998 sp->value.i= (sp->value.l<=spr->value.i); sp->ops= &intScalar; }
LessEQLL(void)999 void LessEQLL(void) { Symbol *spr= sp--;
1000 sp->value.i= (sp->value.l<=spr->value.l); sp->ops= &intScalar; }
LessEQLD(void)1001 void LessEQLD(void) { Symbol *spr= sp--;
1002 sp->value.i= (sp->value.l<=spr->value.d); sp->ops= &intScalar; }
LessEQLB(void)1003 void LessEQLB(void)
1004 { LessEQ_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
1005
LessEQDI(void)1006 void LessEQDI(void) { Symbol *spr= sp--;
1007 sp->value.i= (sp->value.d<=spr->value.i); sp->ops= &intScalar; }
LessEQDL(void)1008 void LessEQDL(void) { Symbol *spr= sp--;
1009 sp->value.i= (sp->value.d<=spr->value.l); sp->ops= &intScalar; }
LessEQDD(void)1010 void LessEQDD(void) { Symbol *spr= sp--;
1011 sp->value.i= (sp->value.d<=spr->value.d); sp->ops= &intScalar; }
LessEQDB(void)1012 void LessEQDB(void)
1013 { LessEQ_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
1014
LessEQBI(void)1015 void LessEQBI(void)
1016 { LessEQ_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
LessEQBL(void)1017 void LessEQBL(void)
1018 { LessEQ_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
LessEQBD(void)1019 void LessEQBD(void)
1020 { LessEQ_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
LessEQBB(void)1021 void LessEQBB(void)
1022 { LessEQ_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
1023
LessEQ_BB(Operand * l,Operand * r)1024 static void LessEQ_BB(Operand *l, Operand *r)
1025 {
1026 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
1027 if (!ops) YError("bad data type(s) in binary <=");
1028 ops->GreaterEQ(r, l);
1029 PopTo(sp-1); /* instead of Drop(1), since args reversed */
1030 }
1031
1032 /*--------------------------------------------------------------------------*/
1033 /* Equal */
1034
Equal(void)1035 void Equal(void) { (sp-1)->ops->Equal[sp->ops->id](); }
1036
1037 static void Equal_BB(Operand *l, Operand *r);
1038
EqualII(void)1039 void EqualII(void) { Symbol *spr= sp--;
1040 sp->value.i= (sp->value.i==spr->value.i); }
EqualIL(void)1041 void EqualIL(void) { Symbol *spr= sp--;
1042 sp->value.i= (sp->value.i==spr->value.l); }
EqualID(void)1043 void EqualID(void) { Symbol *spr= sp--;
1044 sp->value.i= (sp->value.i==spr->value.d); }
EqualIB(void)1045 void EqualIB(void)
1046 { Equal_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
1047
EqualLI(void)1048 void EqualLI(void) { Symbol *spr= sp--;
1049 sp->value.i= (sp->value.l==spr->value.i); sp->ops= &intScalar; }
EqualLL(void)1050 void EqualLL(void) { Symbol *spr= sp--;
1051 sp->value.i= (sp->value.l==spr->value.l); sp->ops= &intScalar; }
EqualLD(void)1052 void EqualLD(void) { Symbol *spr= sp--;
1053 sp->value.i= (sp->value.l==spr->value.d); sp->ops= &intScalar; }
EqualLB(void)1054 void EqualLB(void)
1055 { Equal_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
1056
EqualDI(void)1057 void EqualDI(void) { Symbol *spr= sp--;
1058 sp->value.i= (sp->value.d==spr->value.i); sp->ops= &intScalar; }
EqualDL(void)1059 void EqualDL(void) { Symbol *spr= sp--;
1060 sp->value.i= (sp->value.d==spr->value.l); sp->ops= &intScalar; }
EqualDD(void)1061 void EqualDD(void) { Symbol *spr= sp--;
1062 sp->value.i= (sp->value.d==spr->value.d); sp->ops= &intScalar; }
EqualDB(void)1063 void EqualDB(void)
1064 { Equal_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
1065
EqualBI(void)1066 void EqualBI(void)
1067 { Equal_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
EqualBL(void)1068 void EqualBL(void)
1069 { Equal_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
EqualBD(void)1070 void EqualBD(void)
1071 { Equal_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
EqualBB(void)1072 void EqualBB(void)
1073 { Equal_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
1074
Equal_BB(Operand * l,Operand * r)1075 static void Equal_BB(Operand *l, Operand *r)
1076 {
1077 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
1078 if (ops) {
1079 ops->Equal(l, r);
1080 Drop(1);
1081 } else {
1082 /* If the data types don't match, the operands certainly aren't == */
1083 /* Can pointer or string be ==0? */
1084 Drop(2);
1085 PushIntValue(0);
1086 }
1087 }
1088
1089 static void EqualError(void);
EqualError(void)1090 static void EqualError(void)
1091 { YError("operands not conformable in binary =="); }
1092
1093 #undef OPERATION
1094 #define OPERATION(opname, typd) \
1095 void opname(Operand *l, Operand *r) \
1096 { int *dst= BuildResult0(l, r, &intStruct); \
1097 if (dst) { \
1098 long i, n= l->type.number; \
1099 typd *lv= l->value; typd *rv= r->value; \
1100 for (i=0 ; i<n ; i++) dst[i]= lv[i]==rv[i]; \
1101 PopToI(l->owner); \
1102 } else EqualError(); }
1103
OPERATION(EqualC,char)1104 OPERATION(EqualC, char)
1105 OPERATION(EqualS, short)
1106 OPERATION(EqualI, int)
1107 OPERATION(EqualL, long)
1108 OPERATION(EqualF, float)
1109 OPERATION(EqualD, double)
1110 void EqualZ(Operand *l, Operand *r)
1111 { int *dst= BuildResult0(l, r, &intStruct);
1112 if (dst) {
1113 long i, n= l->type.number;
1114 double *lv= l->value, *rv= r->value;
1115 for (i=0 ; i<n ; i++) dst[i]= (lv[2*i]==rv[2*i] && lv[2*i+1]==rv[2*i+1]);
1116 PopToI(l->owner);
1117 } else EqualError();
1118 }
1119
EqualQ(Operand * l,Operand * r)1120 void EqualQ(Operand *l, Operand *r)
1121 {
1122 int *dst= BuildResult0(l, r, &intStruct);
1123 if (dst) {
1124 long i, n= l->type.number;
1125 char **lv= l->value, **rv= r->value, *ls, *rs;
1126 for (i=0 ; i<n ; i++) {
1127 ls= lv[i]; rs= rv[i];
1128 if (ls && rs) dst[i]= strcmp(ls, rs)==0;
1129 else dst[i]= (ls==rs);
1130 }
1131 PopToI(l->owner);
1132 } else EqualError();
1133 }
1134
OPERATION(EqualP,void *)1135 OPERATION(EqualP, void *)
1136
1137 void EqualSI(Operand *l, Operand *r)
1138 {
1139 int *dst= BuildResult0(l, r, &intStruct);
1140 if (dst) {
1141 long i, n= l->type.number;
1142 if (StructEqual(l->type.base, r->type.base)) {
1143 long size= l->type.base->size;
1144 char *lv= l->value, *rv= r->value;
1145 for (i=0 ; i<n ; i++) {
1146 dst[i]= memcmp(lv, rv, size)==0;
1147 lv+= size;
1148 rv+= size;
1149 }
1150 } else {
1151 for (i=0 ; i<n ; i++) dst[i]= 0;
1152 }
1153 PopToI(l->owner);
1154 } else EqualError();
1155 }
1156
EqualR(Operand * l,Operand * r)1157 void EqualR(Operand *l, Operand *r)
1158 {
1159 Range *lop= (Range *)l->owner->value.db, *rop= (Range *)r->owner->value.db;
1160 long lmin= lop->min, linc= lop->inc;
1161 int value= (lop->nilFlags==rop->nilFlags) && (lmin==rop->min) &&
1162 (linc==rop->inc) && ((lop->max-lmin)/linc == (rop->max-lmin)/linc);
1163 PushIntValue(value);
1164 PopToI(l->owner);
1165 }
1166
EqualX(Operand * l,Operand * r)1167 void EqualX(Operand *l, Operand *r)
1168 {
1169 DataBlock *lop= l->owner->value.db, *rop= r->owner->value.db;
1170 PushIntValue(lop==rop);
1171 PopToI(l->owner);
1172 }
1173
1174 /*--------------------------------------------------------------------------*/
1175 /* NotEqual */
1176
NotEqual(void)1177 void NotEqual(void) { (sp-1)->ops->NotEqual[sp->ops->id](); }
1178
1179 static void NotEqual_BB(Operand *l, Operand *r);
1180
NotEqualII(void)1181 void NotEqualII(void) { Symbol *spr= sp--;
1182 sp->value.i= (sp->value.i!=spr->value.i); }
NotEqualIL(void)1183 void NotEqualIL(void) { Symbol *spr= sp--;
1184 sp->value.i= (sp->value.i!=spr->value.l); }
NotEqualID(void)1185 void NotEqualID(void) { Symbol *spr= sp--;
1186 sp->value.i= (sp->value.i!=spr->value.d); }
NotEqualIB(void)1187 void NotEqualIB(void)
1188 { NotEqual_BB(FormOperandIS(sp-1, &lop), FormOperandDB(sp, &rop)); }
1189
NotEqualLI(void)1190 void NotEqualLI(void) { Symbol *spr= sp--;
1191 sp->value.i= (sp->value.l!=spr->value.i); sp->ops= &intScalar; }
NotEqualLL(void)1192 void NotEqualLL(void) { Symbol *spr= sp--;
1193 sp->value.i= (sp->value.l!=spr->value.l); sp->ops= &intScalar; }
NotEqualLD(void)1194 void NotEqualLD(void) { Symbol *spr= sp--;
1195 sp->value.i= (sp->value.l!=spr->value.d); sp->ops= &intScalar; }
NotEqualLB(void)1196 void NotEqualLB(void)
1197 { NotEqual_BB(FormOperandLS(sp-1, &lop), FormOperandDB(sp, &rop)); }
1198
NotEqualDI(void)1199 void NotEqualDI(void) { Symbol *spr= sp--;
1200 sp->value.i= (sp->value.d!=spr->value.i); sp->ops= &intScalar; }
NotEqualDL(void)1201 void NotEqualDL(void) { Symbol *spr= sp--;
1202 sp->value.i= (sp->value.d!=spr->value.l); sp->ops= &intScalar; }
NotEqualDD(void)1203 void NotEqualDD(void) { Symbol *spr= sp--;
1204 sp->value.i= (sp->value.d!=spr->value.d); sp->ops= &intScalar; }
NotEqualDB(void)1205 void NotEqualDB(void)
1206 { NotEqual_BB(FormOperandDS(sp-1, &lop), FormOperandDB(sp, &rop)); }
1207
NotEqualBI(void)1208 void NotEqualBI(void)
1209 { NotEqual_BB(FormOperandDB(sp-1, &lop), FormOperandIS(sp, &rop)); }
NotEqualBL(void)1210 void NotEqualBL(void)
1211 { NotEqual_BB(FormOperandDB(sp-1, &lop), FormOperandLS(sp, &rop)); }
NotEqualBD(void)1212 void NotEqualBD(void)
1213 { NotEqual_BB(FormOperandDB(sp-1, &lop), FormOperandDS(sp, &rop)); }
NotEqualBB(void)1214 void NotEqualBB(void)
1215 { NotEqual_BB(FormOperandDB(sp-1, &lop), FormOperandDB(sp, &rop)); }
1216
NotEqual_BB(Operand * l,Operand * r)1217 static void NotEqual_BB(Operand *l, Operand *r)
1218 {
1219 Operations *ops= l->ops->Promote[r->ops->promoteID](l, r);
1220 if (ops) {
1221 ops->NotEqual(l, r);
1222 Drop(1);
1223 } else {
1224 /* If the data types don't match, the operands certainly are != */
1225 /* Can pointer or string be !=0? */
1226 Drop(2);
1227 PushIntValue(1);
1228 }
1229 }
1230
1231 static void NotEqualError(void);
NotEqualError(void)1232 static void NotEqualError(void)
1233 { YError("operands not conformable in binary !="); }
1234
1235 #undef OPERATION
1236 #define OPERATION(opname, typd) \
1237 void opname(Operand *l, Operand *r) \
1238 { int *dst= BuildResult0(l, r, &intStruct); \
1239 if (dst) { \
1240 long i, n= l->type.number; \
1241 typd *lv= l->value; typd *rv= r->value; \
1242 for (i=0 ; i<n ; i++) dst[i]= lv[i]!=rv[i]; \
1243 PopToI(l->owner); \
1244 } else NotEqualError(); }
1245
OPERATION(NotEqualC,char)1246 OPERATION(NotEqualC, char)
1247 OPERATION(NotEqualS, short)
1248 OPERATION(NotEqualI, int)
1249 OPERATION(NotEqualL, long)
1250 OPERATION(NotEqualF, float)
1251 OPERATION(NotEqualD, double)
1252 void NotEqualZ(Operand *l, Operand *r)
1253 { int *dst= BuildResult0(l, r, &intStruct);
1254 if (dst) {
1255 long i, n= l->type.number;
1256 double *lv= l->value, *rv= r->value;
1257 for (i=0 ; i<n ; i++) dst[i]= (lv[2*i]!=rv[2*i] || lv[2*i+1]!=rv[2*i+1]);
1258 PopToI(l->owner);
1259 } else NotEqualError();
1260 }
1261
NotEqualQ(Operand * l,Operand * r)1262 void NotEqualQ(Operand *l, Operand *r)
1263 {
1264 int *dst= BuildResult0(l, r, &intStruct);
1265 if (dst) {
1266 long i, n= l->type.number;
1267 char **lv= l->value, **rv= r->value, *ls, *rs;
1268 for (i=0 ; i<n ; i++) {
1269 ls= lv[i]; rs= rv[i];
1270 if (ls && rs) dst[i]= strcmp(ls, rs)!=0;
1271 else dst[i]= (ls!=rs);
1272 }
1273 PopToI(l->owner);
1274 } else NotEqualError();
1275 }
1276
OPERATION(NotEqualP,void *)1277 OPERATION(NotEqualP, void *)
1278
1279 void NotEqualSI(Operand *l, Operand *r)
1280 {
1281 int *dst= BuildResult0(l, r, &intStruct);
1282 if (dst) {
1283 long i, n= l->type.number;
1284 if (StructEqual(l->type.base, r->type.base)) {
1285 long size= l->type.base->size;
1286 char *lv= l->value, *rv= r->value;
1287 for (i=0 ; i<n ; i++) {
1288 dst[i]= memcmp(lv, rv, size)!=0;
1289 lv+= size;
1290 rv+= size;
1291 }
1292 } else {
1293 for (i=0 ; i<n ; i++) dst[i]= 1;
1294 }
1295 PopToI(l->owner);
1296 } else NotEqualError();
1297 }
1298
NotEqualR(Operand * l,Operand * r)1299 void NotEqualR(Operand *l, Operand *r)
1300 {
1301 Range *lop= (Range *)l->owner->value.db, *rop= (Range *)r->owner->value.db;
1302 long lmin= lop->min, linc= lop->inc;
1303 int value= (lop->nilFlags!=rop->nilFlags) || (lmin!=rop->min) ||
1304 (linc!=rop->inc) || ((lop->max-lmin)/linc != (rop->max-lmin)/linc);
1305 PushIntValue(value);
1306 PopToI(l->owner);
1307 }
1308
NotEqualX(Operand * l,Operand * r)1309 void NotEqualX(Operand *l, Operand *r)
1310 {
1311 DataBlock *lop= l->owner->value.db, *rop= r->owner->value.db;
1312 PushIntValue(lop!=rop);
1313 PopToI(l->owner);
1314 }
1315
1316 /*--------------------------------------------------------------------------*/
1317