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