Pristine Ack-5.5
[Ack-5.5.git] / lang / cem / cemcom / ch7bin.c
1 /*
2  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
3  * See the copyright notice in the ACK home directory, in the file "Copyright".
4  */
5 /* $Id: ch7bin.c,v 3.23 1994/06/24 12:02:28 ceriel Exp $ */
6 /* SEMANTIC ANALYSIS (CHAPTER 7RM)  --  BINARY OPERATORS */
7
8 #include        "botch_free.h"
9 #include        <alloc.h>
10 #include        "nofloat.h"
11 #include        "lint.h"
12 #include        "idf.h"
13 #include        "arith.h"
14 #include        "type.h"
15 #include        "struct.h"
16 #include        "label.h"
17 #include        "expr.h"
18 #include        "Lpars.h"
19 #include        "noRoption.h"
20
21 extern char options[];
22 extern char *symbol2str();
23
24 /*      This chapter asks for the repeated application of code to handle
25         an operation that may be executed at compile time or at run time,
26         depending on the constancy of the operands.
27 */
28
29 #define commutative_binop(expp, oper, expr)     mk_binop(expp, oper, expr, 1)
30 #define non_commutative_binop(expp, oper, expr) mk_binop(expp, oper, expr, 0)
31
32 ch7bin(expp, oper, expr)
33         register struct expr **expp;
34         struct expr *expr;
35 {
36         /*      apply binary operator oper between *expp and expr.
37                 NB: don't swap operands if op is one of the op= operators!!!
38         */
39
40         any2opnd(expp, oper);
41         any2opnd(&expr, oper);
42         switch (oper)   {
43         case '[':                               /* RM 7.1 */
44                 /* RM 14.3 states that indexing follows the commutative laws */
45                 switch ((*expp)->ex_type->tp_fund)      {
46                 case POINTER:
47                 case ARRAY:
48                         break;
49                 case ERRONEOUS:
50                         return;
51                 default:                /* unindexable */
52                         switch (expr->ex_type->tp_fund) {
53                         case POINTER:
54                         case ARRAY:
55                                 break;
56                         case ERRONEOUS:
57                                 return;
58                         default:
59                                 expr_error(*expp,
60                                         "indexing an object of type %s",
61                                         symbol2str((*expp)->ex_type->tp_fund));
62                                 return;
63                         }
64                         break;
65                 }
66                 ch7bin(expp, '+', expr);
67                 ch7mon('*', expp);
68                 break;
69
70         case '(':                               /* RM 7.1 */
71                 if (    (*expp)->ex_type->tp_fund == POINTER &&
72                         (*expp)->ex_type->tp_up->tp_fund == FUNCTION
73                 )       {
74 #ifndef NOROPTION
75                         if (options['R'])
76                                 warning("function pointer called");
77 #endif /* NOROPTION */
78                         ch7mon('*', expp);
79                 }
80                 switch ((*expp)->ex_type->tp_fund)      {
81                 case FUNCTION:
82                         *expp = new_oper((*expp)->ex_type->tp_up,
83                                         *expp, '(', expr);
84                         break;
85                 default:                /* uncallable */
86                         expr_error(*expp, "calling an object of type %s",
87                                 symbol2str((*expp)->ex_type->tp_fund));
88                 case ERRONEOUS:         /* uncallable but no message */
89                         /* leave the expression; it may still serve */
90                         free_expression(expr);  /* there go the parameters */
91                         break;
92                 }
93                 (*expp)->ex_flags |= EX_SIDEEFFECTS;
94                 break;
95
96         case PARCOMMA:                          /* RM 7.1 */
97                 if ((*expp)->ex_type->tp_fund == FUNCTION)
98                         function2pointer(*expp);
99                 *expp = new_oper(expr->ex_type, *expp, PARCOMMA, expr);
100                 break;
101
102         case '%':
103         case MODAB:
104         case ANDAB:
105         case XORAB:
106         case ORAB:
107                 opnd2integral(expp, oper);
108                 opnd2integral(&expr, oper);
109                 /* Fall through */
110         case '/':
111         case DIVAB:
112         case TIMESAB:
113                 arithbalance(expp, oper, &expr);
114                 non_commutative_binop(expp, oper, expr);
115                 if (oper != '/' && oper != '%') {
116                         (*expp)->ex_flags |= EX_SIDEEFFECTS;
117                 }
118                 break;
119
120         case '&':
121         case '^':
122         case '|':
123                 opnd2integral(expp, oper);
124                 opnd2integral(&expr, oper);
125                 /* Fall through */
126         case '*':
127                 arithbalance(expp, oper, &expr);
128                 commutative_binop(expp, oper, expr);
129                 break;
130
131         case '+':
132                 if (expr->ex_type->tp_fund == POINTER)  { /* swap operands */
133                         struct expr *etmp = expr;
134                         expr = *expp;
135                         *expp = etmp;
136                 }
137                 /*FALLTHROUGH*/
138         case PLUSAB:
139         case POSTINCR:
140         case PLUSPLUS:
141                 if ((*expp)->ex_type->tp_fund == POINTER)       {
142                         pointer_arithmetic(expp, oper, &expr);
143                         if (expr->ex_type->tp_size != (*expp)->ex_type->tp_size)
144                                 ch7cast(&expr, CAST, (*expp)->ex_type);
145                         pointer_binary(expp, oper, expr);
146                 }
147                 else    {
148                         arithbalance(expp, oper, &expr);
149                         if (oper == '+')
150                                 commutative_binop(expp, oper, expr);
151                         else
152                                 non_commutative_binop(expp, oper, expr);
153                 }
154                 if (oper != '+') {
155                         (*expp)->ex_flags |= EX_SIDEEFFECTS;
156                 }
157                 break;
158
159         case '-':
160         case MINAB:
161         case POSTDECR:
162         case MINMIN:
163                 if ((*expp)->ex_type->tp_fund == POINTER)       {
164                         if (expr->ex_type->tp_fund == POINTER)
165                                 pntminuspnt(expp, oper, expr);
166                         else {
167                                 pointer_arithmetic(expp, oper, &expr);
168                                 pointer_binary(expp, oper, expr);
169                         }
170                 }
171                 else    {
172                         arithbalance(expp, oper, &expr);
173                         non_commutative_binop(expp, oper, expr);
174                 }
175                 if (oper != '-') {
176                         (*expp)->ex_flags |= EX_SIDEEFFECTS;
177                 }
178                 break;
179
180         case LEFT:
181         case RIGHT:
182         case LEFTAB:
183         case RIGHTAB:
184                 opnd2integral(expp, oper);
185                 opnd2integral(&expr, oper);
186                 arithbalance(expp, oper, &expr); /* ch. 7.5 */
187                 ch7cast(&expr, oper, int_type); /* cvt. rightop to int */
188                 non_commutative_binop(expp, oper, expr);
189                 if (oper != LEFT && oper != RIGHT) {
190                         (*expp)->ex_flags |= EX_SIDEEFFECTS;
191                 }
192                 break;
193
194         case '<':
195         case '>':
196         case LESSEQ:
197         case GREATEREQ:
198         case EQUAL:
199         case NOTEQUAL:
200                 relbalance(expp, oper, &expr);
201                 if (oper == EQUAL || oper == NOTEQUAL) {
202                         commutative_binop(expp, oper, expr);
203                 }
204                 else    non_commutative_binop(expp, oper, expr);
205                 (*expp)->ex_type = int_type;
206                 break;
207
208         case AND:
209         case OR:
210                 opnd2test(expp, oper);
211                 opnd2test(&expr, oper);
212                 if (is_cp_cst(*expp))   {
213                         register struct expr *ex = *expp;
214
215                         /* the following condition is a short-hand for
216                                 ((oper == AND) && o1) || ((oper == OR) && !o1)
217                                 where o1 == (*expp)->VL_VALUE;
218                                 and ((oper == AND) || (oper == OR))
219                         */
220                         if ((oper == AND) == (ex->VL_VALUE != (arith)0))
221                                 *expp = expr;
222                         else {
223                                 ex->ex_flags |= expr->ex_flags;
224                                 free_expression(expr);
225                                 *expp = intexpr((arith)((oper == AND) ? 0 : 1),
226                                                 INT);
227                         }
228                         (*expp)->ex_flags |= ex->ex_flags;
229                         free_expression(ex);
230                 }
231                 else
232                 if (is_cp_cst(expr))    {
233                         /* Note!!!: the following condition is a short-hand for
234                                 ((oper == AND) && o2) || ((oper == OR) && !o2)
235                                 where o2 == expr->VL_VALUE
236                                 and ((oper == AND) || (oper == OR))
237                         */
238                         if ((oper == AND) == (expr->VL_VALUE != (arith)0)) {
239                                 (*expp)->ex_flags |= expr->ex_flags;
240                                 free_expression(expr);
241                         }
242                         else {
243                                 if (oper == OR)
244                                         expr->VL_VALUE = (arith)1;
245                                 ch7bin(expp, ',', expr);
246                         }
247                 }
248                 else
249                         *expp = new_oper(int_type, *expp, oper, expr);
250                 (*expp)->ex_flags |= EX_LOGICAL;
251                 break;
252
253         case ':':
254                 if (    is_struct_or_union((*expp)->ex_type->tp_fund)
255                 ||      is_struct_or_union(expr->ex_type->tp_fund)
256                 )       {
257                         if ((*expp)->ex_type != expr->ex_type)
258                                 expr_error(*expp, "illegal balance");
259                 }
260                 else
261                         relbalance(expp, oper, &expr);
262 #ifdef  LINT
263                 if (    (is_cp_cst(*expp) && is_cp_cst(expr))
264                 &&      (*expp)->VL_VALUE == expr->VL_VALUE
265                 ) {
266                         hwarning("operands of : are constant and equal");
267                 }
268 #endif  /* LINT */
269                 *expp = new_oper((*expp)->ex_type, *expp, oper, expr);
270                 break;
271
272         case '?':
273                 opnd2logical(expp, oper);
274                 if (is_cp_cst(*expp)) {
275 #ifdef  LINT
276                         hwarning("condition in ?: expression is constant");
277 #endif  /* LINT */
278                         *expp = (*expp)->VL_VALUE ?
279                                 expr->OP_LEFT : expr->OP_RIGHT;
280                 }
281                 else {
282                         *expp = new_oper(expr->ex_type, *expp, oper, expr);
283                 }
284                 break;
285
286         case ',':
287                 if (is_cp_cst(*expp)) {
288 #ifdef  LINT
289                         hwarning("constant expression ignored");
290 #endif  /* LINT */
291                         *expp = expr;
292                 }
293                 else {
294                         *expp = new_oper(expr->ex_type, *expp, oper, expr);
295                 }
296                 (*expp)->ex_flags |= EX_COMMA;
297                 break;
298         }
299 }
300
301 pntminuspnt(expp, oper, expr)
302         register struct expr **expp, *expr;
303 {
304         /*      Subtracting two pointers is so complicated it merits a
305                 routine of its own.
306         */
307         struct type *up_type = (*expp)->ex_type->tp_up;
308
309         if (up_type != expr->ex_type->tp_up)    {
310                 expr_error(*expp, "subtracting incompatible pointers");
311                 free_expression(expr);
312                 erroneous2int(expp);
313                 return;
314         }
315         /*      we hope the optimizer will eliminate the load-time
316                 pointer subtraction
317         */
318         *expp = new_oper((*expp)->ex_type, *expp, oper, expr);
319         ch7cast(expp, CAST, pa_type);   /* ptr-ptr: result has pa_type  */
320         ch7bin(expp, '/',
321                 intexpr(size_of_type(up_type, "object"), pa_type->tp_fund));
322         ch7cast(expp, CAST, int_type);  /* result will be an integer expr */
323 }
324
325 mk_binop(expp, oper, expr, commutative)
326         struct expr **expp;
327         register struct expr *expr;
328 {
329         /*      Constructs in *expp the operation indicated by the operands.
330                 "commutative" indicates whether "oper" is a commutative
331                 operator.
332         */
333         register struct expr *ex = *expp;
334
335         if (is_cp_cst(expr) && is_cp_cst(ex))
336                 cstbin(expp, oper, expr);
337         else    {
338                 *expp = (commutative &&
339                           ( expr->ex_depth > ex->ex_depth ||
340                             (expr->ex_flags & EX_SIDEEFFECTS) ||
341                             is_cp_cst(ex))) ?
342                                 new_oper(ex->ex_type, expr, oper, ex) :
343                                 new_oper(ex->ex_type, ex, oper, expr);
344         }
345 }
346
347 pointer_arithmetic(expp1, oper, expp2)
348         register struct expr **expp1, **expp2;
349 {
350         /*      prepares the integral expression expp2 in order to
351                 apply it to the pointer expression expp1
352         */
353 #ifndef NOFLOAT
354         if (any2arith(expp2, oper) == DOUBLE)   {
355                 expr_error(*expp2,
356                         "illegal combination of float and pointer");
357                 erroneous2int(expp2);
358         }
359 #endif /* NOFLOAT */
360         ch7bin( expp2, '*',
361                 intexpr(size_of_type((*expp1)->ex_type->tp_up, "object"),
362                         pa_type->tp_fund)
363         );
364 }
365
366 pointer_binary(expp, oper, expr)
367         register struct expr **expp, *expr;
368 {
369         /*      constructs the pointer arithmetic expression out of
370                 a pointer expression, a binary operator and an integral
371                 expression.
372         */
373         if (is_ld_cst(expr) && is_ld_cst(*expp))
374                 cstbin(expp, oper, expr);
375         else
376                 *expp = new_oper((*expp)->ex_type, *expp, oper, expr);
377 }