Branch data Line data Source code
1 : : /* m2expr.cc provides an interface to GCC expression trees.
2 : :
3 : : Copyright (C) 2012-2025 Free Software Foundation, Inc.
4 : : Contributed by Gaius Mulley <gaius@glam.ac.uk>.
5 : :
6 : : This file is part of GNU Modula-2.
7 : :
8 : : GNU Modula-2 is free software; you can redistribute it and/or modify
9 : : it under the terms of the GNU General Public License as published by
10 : : the Free Software Foundation; either version 3, or (at your option)
11 : : any later version.
12 : :
13 : : GNU Modula-2 is distributed in the hope that it will be useful, but
14 : : WITHOUT ANY WARRANTY; without even the implied warranty of
15 : : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 : : General Public License for more details.
17 : :
18 : : You should have received a copy of the GNU General Public License
19 : : along with GNU Modula-2; see the file COPYING3. If not see
20 : : <http://www.gnu.org/licenses/>. */
21 : :
22 : : #include "gcc-consolidation.h"
23 : :
24 : : #include "../gm2-lang.h"
25 : : #include "../m2-tree.h"
26 : : #include "m2convert.h"
27 : :
28 : : /* Prototypes. */
29 : :
30 : : #define m2expr_c
31 : : #include "m2assert.h"
32 : : #include "m2builtins.h"
33 : : #include "m2convert.h"
34 : : #include "m2decl.h"
35 : : #include "m2expr.h"
36 : : #include "m2options.h"
37 : : #include "m2range.h"
38 : : #include "m2statement.h"
39 : : #include "m2tree.h"
40 : : #include "m2treelib.h"
41 : : #include "m2type.h"
42 : : #include "m2linemap.h"
43 : : #include "math.h"
44 : :
45 : : static void m2expr_checkRealOverflow (location_t location, enum tree_code code,
46 : : tree result);
47 : : static tree checkWholeNegateOverflow (location_t location, tree i, tree lowest,
48 : : tree min, tree max);
49 : : // static tree m2expr_Build4LogicalAnd (location_t location, tree a, tree b,
50 : : // tree c, tree d);
51 : : static tree m2expr_Build4LogicalOr (location_t location, tree a, tree b,
52 : : tree c, tree d);
53 : : static tree m2expr_Build4TruthOrIf (location_t location, tree a, tree b,
54 : : tree c, tree d);
55 : : static tree m2expr_Build4TruthAndIf (location_t location, tree a, tree b,
56 : : tree c, tree d);
57 : :
58 : : static int label_count = 0;
59 : : static GTY (()) tree set_full_complement;
60 : :
61 : : /* Return an integer string using base 10 and no padding. The string returned
62 : : will have been malloc'd. */
63 : :
64 : : char *
65 : 114 : m2expr_CSTIntToString (tree t)
66 : : {
67 : 114 : char val[100];
68 : :
69 : 114 : snprintf (val, 100, HOST_WIDE_INT_PRINT_UNSIGNED, TREE_INT_CST_LOW (t));
70 : 114 : return xstrndup (val, 100);
71 : : }
72 : :
73 : : /* Return the char representation of tree t. */
74 : :
75 : : char
76 : 834 : m2expr_CSTIntToChar (tree t)
77 : : {
78 : 834 : return (char) (TREE_INT_CST_LOW (t));
79 : : }
80 : :
81 : : /* CompareTrees returns -1 if e1 < e2, 0 if e1 == e2, and 1 if e1 > e2. */
82 : :
83 : : int
84 : 27679082 : m2expr_CompareTrees (tree e1, tree e2)
85 : : {
86 : 27679082 : return tree_int_cst_compare (m2expr_FoldAndStrip (e1),
87 : 27679082 : m2expr_FoldAndStrip (e2));
88 : : }
89 : :
90 : : /* FoldAndStrip return expression, t, after it has been folded (if
91 : : possible). */
92 : :
93 : : tree
94 : 81463765 : m2expr_FoldAndStrip (tree t)
95 : : {
96 : 81463765 : if (t != NULL)
97 : : {
98 : 81463765 : t = fold (t);
99 : 81463765 : if (TREE_CODE (t) == CONST_DECL)
100 : 0 : return m2expr_FoldAndStrip (DECL_INITIAL (t));
101 : : }
102 : :
103 : : return t;
104 : : }
105 : :
106 : : /* StringLength returns an unsigned int which is the length of, string. */
107 : :
108 : : unsigned int
109 : 1461896 : m2expr_StringLength (tree string)
110 : : {
111 : 1461896 : return TREE_STRING_LENGTH (string);
112 : : }
113 : :
114 : : /* BuildCondIfExpression returns a tree containing (condition) ? (left) : right. */
115 : :
116 : : tree
117 : 0 : m2expr_BuildCondIfExpression (tree condition, tree type, tree left, tree right)
118 : : {
119 : 0 : return fold_build3 (COND_EXPR, type, condition, left, right);
120 : : }
121 : :
122 : : /* CheckAddressToCardinal if op is a pointer convert it to the ADDRESS type. */
123 : :
124 : : static tree
125 : 1596222 : CheckAddressToCardinal (location_t location, tree op)
126 : : {
127 : 1596222 : if (m2type_IsAddress (TREE_TYPE (op)))
128 : 48010 : return m2convert_BuildConvert (location, m2type_GetCardinalAddressType (),
129 : 48010 : op, false);
130 : : return op;
131 : : }
132 : :
133 : : /* BuildTruthAndIf return true if a && b. Retain order left to right. */
134 : :
135 : : static tree
136 : 16400 : m2expr_BuildTruthAndIf (location_t location, tree a, tree b)
137 : : {
138 : 0 : return m2expr_build_binary_op (location, TRUTH_ANDIF_EXPR, a, b, false);
139 : : }
140 : :
141 : : /* BuildTruthOrIf return true if a || b. Retain order left to right. */
142 : :
143 : : static tree
144 : 6632 : m2expr_BuildTruthOrIf (location_t location, tree a, tree b)
145 : : {
146 : 0 : return m2expr_build_binary_op (location, TRUTH_ORIF_EXPR, a, b, false);
147 : : }
148 : :
149 : : /* BuildTruthNotIf inverts the boolean value of expr and returns the result. */
150 : :
151 : : static tree
152 : 128 : m2expr_BuildTruthNot (location_t location, tree expr)
153 : : {
154 : 0 : return m2expr_build_unary_op (location, TRUTH_NOT_EXPR, expr, false);
155 : : }
156 : :
157 : : /* BuildPostInc builds a post increment tree, the second operand is
158 : : always one. */
159 : :
160 : : static tree
161 : 148 : m2expr_BuildPostInc (location_t location, tree op)
162 : : {
163 : 148 : return m2expr_BuildAdd (location, op, build_int_cst (TREE_TYPE (op), 1), false);
164 : : }
165 : :
166 : : /* BuildPostDec builds a post decrement tree, the second operand is
167 : : always one. */
168 : :
169 : : static tree
170 : 444 : m2expr_BuildPostDec (location_t location, tree op)
171 : : {
172 : 444 : return m2expr_BuildSub (location, op, build_int_cst (TREE_TYPE (op), 1), false);
173 : : }
174 : :
175 : : /* BuildAddCheck builds an addition tree. */
176 : :
177 : : tree
178 : 20986 : m2expr_BuildAddCheck (location_t location, tree op1, tree op2, tree lowest,
179 : : tree min, tree max)
180 : : {
181 : 20986 : tree t;
182 : :
183 : 20986 : m2assert_AssertLocation (location);
184 : :
185 : 20986 : op1 = m2expr_FoldAndStrip (op1);
186 : 20986 : op2 = m2expr_FoldAndStrip (op2);
187 : :
188 : 20986 : op1 = CheckAddressToCardinal (location, op1);
189 : 20986 : op2 = CheckAddressToCardinal (location, op2);
190 : :
191 : 20986 : t = m2expr_build_binary_op_check (location, PLUS_EXPR, op1, op2, false,
192 : : lowest, min, max);
193 : 20986 : return m2expr_FoldAndStrip (t);
194 : : }
195 : :
196 : : /* BuildAdd builds an addition tree. */
197 : :
198 : : tree
199 : 166995 : m2expr_BuildAdd (location_t location, tree op1, tree op2, bool needconvert)
200 : : {
201 : 166995 : tree t;
202 : :
203 : 166995 : m2assert_AssertLocation (location);
204 : :
205 : 166995 : op1 = m2expr_FoldAndStrip (op1);
206 : 166995 : op2 = m2expr_FoldAndStrip (op2);
207 : :
208 : 166995 : op1 = CheckAddressToCardinal (location, op1);
209 : 166995 : op2 = CheckAddressToCardinal (location, op2);
210 : :
211 : 166995 : t = m2expr_build_binary_op (location, PLUS_EXPR, op1, op2, needconvert);
212 : 166995 : return m2expr_FoldAndStrip (t);
213 : : }
214 : :
215 : : /* BuildSubCheck builds a subtraction tree. */
216 : :
217 : : tree
218 : 8987 : m2expr_BuildSubCheck (location_t location, tree op1, tree op2, tree lowest,
219 : : tree min, tree max)
220 : : {
221 : 8987 : tree t;
222 : :
223 : 8987 : m2assert_AssertLocation (location);
224 : :
225 : 8987 : op1 = m2expr_FoldAndStrip (op1);
226 : 8987 : op2 = m2expr_FoldAndStrip (op2);
227 : :
228 : 8987 : op1 = CheckAddressToCardinal (location, op1);
229 : 8987 : op2 = CheckAddressToCardinal (location, op2);
230 : :
231 : 8987 : t = m2expr_build_binary_op_check (location, MINUS_EXPR, op1, op2, false,
232 : : lowest, min, max);
233 : 8987 : return m2expr_FoldAndStrip (t);
234 : : }
235 : :
236 : : /* BuildSub builds a subtraction tree. */
237 : :
238 : : tree
239 : 532532 : m2expr_BuildSub (location_t location, tree op1, tree op2, bool needconvert)
240 : : {
241 : 532532 : tree t;
242 : :
243 : 532532 : m2assert_AssertLocation (location);
244 : :
245 : 532532 : op1 = m2expr_FoldAndStrip (op1);
246 : 532532 : op2 = m2expr_FoldAndStrip (op2);
247 : :
248 : 532532 : op1 = CheckAddressToCardinal (location, op1);
249 : 532532 : op2 = CheckAddressToCardinal (location, op2);
250 : :
251 : 532532 : t = m2expr_build_binary_op (location, MINUS_EXPR, op1, op2, needconvert);
252 : 532532 : return m2expr_FoldAndStrip (t);
253 : : }
254 : :
255 : : /* BuildDivTrunc builds a trunc division tree. */
256 : :
257 : : tree
258 : 5324 : m2expr_BuildDivTrunc (location_t location, tree op1, tree op2, bool needconvert)
259 : : {
260 : 5324 : tree t;
261 : :
262 : 5324 : m2assert_AssertLocation (location);
263 : :
264 : 5324 : op1 = m2expr_FoldAndStrip (op1);
265 : 5324 : op2 = m2expr_FoldAndStrip (op2);
266 : :
267 : 5324 : op1 = CheckAddressToCardinal (location, op1);
268 : 5324 : op2 = CheckAddressToCardinal (location, op2);
269 : :
270 : 5324 : t = m2expr_build_binary_op (location, TRUNC_DIV_EXPR, op1, op2, needconvert);
271 : 5324 : return m2expr_FoldAndStrip (t);
272 : : }
273 : :
274 : : /* BuildDivTruncCheck builds a trunc division tree. */
275 : :
276 : : tree
277 : 32 : m2expr_BuildDivTruncCheck (location_t location, tree op1, tree op2, tree lowest,
278 : : tree min, tree max)
279 : : {
280 : 32 : tree t;
281 : :
282 : 32 : m2assert_AssertLocation (location);
283 : :
284 : 32 : op1 = m2expr_FoldAndStrip (op1);
285 : 32 : op2 = m2expr_FoldAndStrip (op2);
286 : :
287 : 32 : op1 = CheckAddressToCardinal (location, op1);
288 : 32 : op2 = CheckAddressToCardinal (location, op2);
289 : :
290 : 32 : t = m2expr_build_binary_op_check (location, TRUNC_DIV_EXPR, op1, op2, false,
291 : : lowest, min, max);
292 : 32 : return m2expr_FoldAndStrip (t);
293 : : }
294 : :
295 : : /* BuildModTruncCheck builds a trunc modulus tree. */
296 : :
297 : : tree
298 : 4 : m2expr_BuildModTruncCheck (location_t location, tree op1, tree op2, tree lowest,
299 : : tree min, tree max)
300 : : {
301 : 4 : tree t;
302 : :
303 : 4 : m2assert_AssertLocation (location);
304 : :
305 : 4 : op1 = m2expr_FoldAndStrip (op1);
306 : 4 : op2 = m2expr_FoldAndStrip (op2);
307 : :
308 : 4 : op1 = CheckAddressToCardinal (location, op1);
309 : 4 : op2 = CheckAddressToCardinal (location, op2);
310 : :
311 : 4 : t = m2expr_build_binary_op_check (location, TRUNC_MOD_EXPR, op1, op2, false,
312 : : lowest, min, max);
313 : 4 : return m2expr_FoldAndStrip (t);
314 : : }
315 : :
316 : : /* BuildModTrunc builds a trunc modulus tree. */
317 : :
318 : : tree
319 : 1532 : m2expr_BuildModTrunc (location_t location, tree op1, tree op2, bool needconvert)
320 : : {
321 : 1532 : tree t;
322 : :
323 : 1532 : m2assert_AssertLocation (location);
324 : :
325 : 1532 : op1 = m2expr_FoldAndStrip (op1);
326 : 1532 : op2 = m2expr_FoldAndStrip (op2);
327 : :
328 : 1532 : op1 = CheckAddressToCardinal (location, op1);
329 : 1532 : op2 = CheckAddressToCardinal (location, op2);
330 : :
331 : 1532 : t = m2expr_build_binary_op (location, TRUNC_MOD_EXPR, op1, op2, needconvert);
332 : 1532 : return m2expr_FoldAndStrip (t);
333 : : }
334 : :
335 : : /* BuildModCeilCheck builds a ceil modulus tree. */
336 : :
337 : : tree
338 : 1878 : m2expr_BuildModCeilCheck (location_t location, tree op1, tree op2, tree lowest,
339 : : tree min, tree max)
340 : : {
341 : 1878 : tree t;
342 : :
343 : 1878 : m2assert_AssertLocation (location);
344 : :
345 : 1878 : op1 = m2expr_FoldAndStrip (op1);
346 : 1878 : op2 = m2expr_FoldAndStrip (op2);
347 : :
348 : 1878 : op1 = CheckAddressToCardinal (location, op1);
349 : 1878 : op2 = CheckAddressToCardinal (location, op2);
350 : :
351 : 1878 : t = m2expr_build_binary_op_check (location, CEIL_MOD_EXPR, op1, op2, false,
352 : : lowest, min, max);
353 : 1878 : return m2expr_FoldAndStrip (t);
354 : : }
355 : :
356 : : /* BuildModFloorCheck builds a trunc modulus tree. */
357 : :
358 : : tree
359 : 1878 : m2expr_BuildModFloorCheck (location_t location, tree op1, tree op2, tree lowest,
360 : : tree min, tree max)
361 : : {
362 : 1878 : tree t;
363 : :
364 : 1878 : m2assert_AssertLocation (location);
365 : :
366 : 1878 : op1 = m2expr_FoldAndStrip (op1);
367 : 1878 : op2 = m2expr_FoldAndStrip (op2);
368 : :
369 : 1878 : op1 = CheckAddressToCardinal (location, op1);
370 : 1878 : op2 = CheckAddressToCardinal (location, op2);
371 : :
372 : 1878 : t = m2expr_build_binary_op_check (location, FLOOR_MOD_EXPR, op1, op2, false,
373 : : lowest, min, max);
374 : 1878 : return m2expr_FoldAndStrip (t);
375 : : }
376 : :
377 : : /* BuildDivCeil builds a ceil division tree. */
378 : :
379 : : tree
380 : 4040 : m2expr_BuildDivCeil (location_t location, tree op1, tree op2, bool needconvert)
381 : : {
382 : 4040 : tree t;
383 : :
384 : 4040 : m2assert_AssertLocation (location);
385 : :
386 : 4040 : op1 = m2expr_FoldAndStrip (op1);
387 : 4040 : op2 = m2expr_FoldAndStrip (op2);
388 : :
389 : 4040 : op1 = CheckAddressToCardinal (location, op1);
390 : 4040 : op2 = CheckAddressToCardinal (location, op2);
391 : :
392 : 4040 : t = m2expr_build_binary_op (location, CEIL_DIV_EXPR, op1, op2, needconvert);
393 : 4040 : return m2expr_FoldAndStrip (t);
394 : : }
395 : :
396 : : /* BuildDivCeilCheck builds a check ceil division tree. */
397 : :
398 : : tree
399 : 1739 : m2expr_BuildDivCeilCheck (location_t location, tree op1, tree op2, tree lowest,
400 : : tree min, tree max)
401 : : {
402 : 1739 : tree t;
403 : :
404 : 1739 : m2assert_AssertLocation (location);
405 : :
406 : 1739 : op1 = m2expr_FoldAndStrip (op1);
407 : 1739 : op2 = m2expr_FoldAndStrip (op2);
408 : :
409 : 1739 : op1 = CheckAddressToCardinal (location, op1);
410 : 1739 : op2 = CheckAddressToCardinal (location, op2);
411 : :
412 : 1739 : t = m2expr_build_binary_op_check (location, CEIL_DIV_EXPR, op1, op2, false,
413 : : lowest, min, max);
414 : 1739 : return m2expr_FoldAndStrip (t);
415 : : }
416 : :
417 : : /* BuildModCeil builds a ceil modulus tree. */
418 : :
419 : : tree
420 : 178 : m2expr_BuildModCeil (location_t location, tree op1, tree op2, bool needconvert)
421 : : {
422 : 178 : tree t;
423 : :
424 : 178 : m2assert_AssertLocation (location);
425 : :
426 : 178 : op1 = m2expr_FoldAndStrip (op1);
427 : 178 : op2 = m2expr_FoldAndStrip (op2);
428 : :
429 : 178 : op1 = CheckAddressToCardinal (location, op1);
430 : 178 : op2 = CheckAddressToCardinal (location, op2);
431 : :
432 : 178 : t = m2expr_build_binary_op (location, CEIL_MOD_EXPR, op1, op2, needconvert);
433 : 178 : return m2expr_FoldAndStrip (t);
434 : : }
435 : :
436 : : /* BuildDivFloor builds a floor division tree. */
437 : :
438 : : tree
439 : 6608 : m2expr_BuildDivFloor (location_t location, tree op1, tree op2, bool needconvert)
440 : : {
441 : 6608 : tree t;
442 : :
443 : 6608 : m2assert_AssertLocation (location);
444 : :
445 : 6608 : op1 = m2expr_FoldAndStrip (op1);
446 : 6608 : op2 = m2expr_FoldAndStrip (op2);
447 : :
448 : 6608 : op1 = CheckAddressToCardinal (location, op1);
449 : 6608 : op2 = CheckAddressToCardinal (location, op2);
450 : :
451 : 6608 : t = m2expr_build_binary_op (location, FLOOR_DIV_EXPR, op1, op2, needconvert);
452 : 6608 : return m2expr_FoldAndStrip (t);
453 : : }
454 : :
455 : : /* BuildDivFloorCheck builds a check floor division tree. */
456 : :
457 : : tree
458 : 1739 : m2expr_BuildDivFloorCheck (location_t location, tree op1, tree op2, tree lowest,
459 : : tree min, tree max)
460 : : {
461 : 1739 : tree t;
462 : :
463 : 1739 : m2assert_AssertLocation (location);
464 : :
465 : 1739 : op1 = m2expr_FoldAndStrip (op1);
466 : 1739 : op2 = m2expr_FoldAndStrip (op2);
467 : :
468 : 1739 : op1 = CheckAddressToCardinal (location, op1);
469 : 1739 : op2 = CheckAddressToCardinal (location, op2);
470 : :
471 : 1739 : t = m2expr_build_binary_op_check (location, FLOOR_DIV_EXPR, op1, op2, false,
472 : : lowest, min, max);
473 : 1739 : return m2expr_FoldAndStrip (t);
474 : : }
475 : :
476 : : /* BuildRDiv builds a division tree (this should only be used for
477 : : REAL and COMPLEX types and NEVER for integer based types). */
478 : :
479 : : tree
480 : 352 : m2expr_BuildRDiv (location_t location, tree op1, tree op2, bool needconvert)
481 : : {
482 : 352 : tree t;
483 : :
484 : 352 : m2assert_AssertLocation (location);
485 : :
486 : 352 : op1 = m2expr_FoldAndStrip (op1);
487 : 352 : op2 = m2expr_FoldAndStrip (op2);
488 : :
489 : 352 : t = m2expr_build_binary_op (location, RDIV_EXPR, op1, op2, needconvert);
490 : 352 : return m2expr_FoldAndStrip (t);
491 : : }
492 : :
493 : : /* BuildModFloor builds a modulus tree. */
494 : :
495 : : tree
496 : 770 : m2expr_BuildModFloor (location_t location, tree op1, tree op2, bool needconvert)
497 : : {
498 : 770 : tree t;
499 : :
500 : 770 : m2assert_AssertLocation (location);
501 : :
502 : 770 : op1 = m2expr_FoldAndStrip (op1);
503 : 770 : op2 = m2expr_FoldAndStrip (op2);
504 : :
505 : 770 : op1 = CheckAddressToCardinal (location, op1);
506 : 770 : op2 = CheckAddressToCardinal (location, op2);
507 : :
508 : 770 : t = m2expr_build_binary_op (location, FLOOR_MOD_EXPR, op1, op2, needconvert);
509 : 770 : return m2expr_FoldAndStrip (t);
510 : : }
511 : :
512 : : /* BuildLSL builds and returns tree (op1 << op2). */
513 : :
514 : : tree
515 : 527966 : m2expr_BuildLSL (location_t location, tree op1, tree op2, bool needconvert)
516 : : {
517 : 527966 : tree t;
518 : :
519 : 527966 : m2assert_AssertLocation (location);
520 : :
521 : 527966 : op1 = m2expr_FoldAndStrip (op1);
522 : 527966 : op2 = m2expr_FoldAndStrip (op2);
523 : :
524 : 527966 : t = m2expr_build_binary_op (location, LSHIFT_EXPR, op1, op2, needconvert);
525 : 527966 : return m2expr_FoldAndStrip (t);
526 : : }
527 : :
528 : : /* BuildLSR builds and returns tree (op1 >> op2). */
529 : :
530 : : tree
531 : 646 : m2expr_BuildLSR (location_t location, tree op1, tree op2, bool needconvert)
532 : : {
533 : 646 : tree t;
534 : :
535 : 646 : m2assert_AssertLocation (location);
536 : :
537 : 646 : op1 = m2expr_FoldAndStrip (op1);
538 : 646 : op2 = m2expr_FoldAndStrip (op2);
539 : :
540 : 646 : t = m2expr_build_binary_op (location, RSHIFT_EXPR, op1, op2, needconvert);
541 : 646 : return m2expr_FoldAndStrip (t);
542 : : }
543 : :
544 : : /* createUniqueLabel returns a unique label which has been alloc'ed. */
545 : :
546 : : static char *
547 : 908 : createUniqueLabel (void)
548 : : {
549 : 908 : int size, i;
550 : 908 : char *label;
551 : :
552 : 908 : label_count++;
553 : 908 : i = label_count;
554 : 908 : size = strlen (".LSHIFT") + 2;
555 : 2002 : while (i > 0)
556 : : {
557 : 1094 : i /= 10;
558 : 1094 : size++;
559 : : }
560 : 908 : label = (char *)ggc_alloc_atomic (size);
561 : 908 : sprintf (label, ".LSHIFT%d", label_count);
562 : 908 : return label;
563 : : }
564 : :
565 : : /* BuildLogicalShift builds the ISO Modula-2 SHIFT operator for a
566 : : fundamental data type. */
567 : :
568 : : void
569 : 516 : m2expr_BuildLogicalShift (location_t location, tree op1, tree op2, tree op3,
570 : : tree nBits ATTRIBUTE_UNUSED, bool needconvert)
571 : : {
572 : 516 : tree res;
573 : :
574 : 516 : m2assert_AssertLocation (location);
575 : 516 : op2 = m2expr_FoldAndStrip (op2);
576 : 516 : op3 = m2expr_FoldAndStrip (op3);
577 : 516 : if (TREE_CODE (op3) == INTEGER_CST)
578 : : {
579 : 132 : op2 = m2convert_ToWord (location, op2);
580 : 132 : if (tree_int_cst_sgn (op3) < 0)
581 : 66 : res = m2expr_BuildLSR (
582 : : location, op2,
583 : : m2convert_ToWord (location,
584 : : m2expr_BuildNegate (location, op3, needconvert)),
585 : : needconvert);
586 : : else
587 : 66 : res = m2expr_BuildLSL (location, op2, m2convert_ToWord (location, op3),
588 : : needconvert);
589 : 132 : res = m2convert_BuildConvert (
590 : 132 : location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, false);
591 : 132 : m2statement_BuildAssignmentTree (location, op1, res);
592 : : }
593 : : else
594 : : {
595 : 384 : char *labelElseName = createUniqueLabel ();
596 : 384 : char *labelEndName = createUniqueLabel ();
597 : 384 : tree is_less = m2expr_BuildLessThan (location,
598 : : m2convert_ToInteger (location, op3),
599 : : m2expr_GetIntegerZero (location));
600 : :
601 : 384 : m2statement_DoJump (location, is_less, NULL, labelElseName);
602 : 384 : op2 = m2convert_ToWord (location, op2);
603 : 384 : op3 = m2convert_ToWord (location, op3);
604 : 384 : res = m2expr_BuildLSL (location, op2, op3, needconvert);
605 : 384 : res = m2convert_BuildConvert (
606 : 384 : location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, false);
607 : 384 : m2statement_BuildAssignmentTree (location, op1, res);
608 : 384 : m2statement_BuildGoto (location, labelEndName);
609 : 384 : m2statement_DeclareLabel (location, labelElseName);
610 : 384 : res = m2expr_BuildLSR (location, op2,
611 : : m2expr_BuildNegate (location, op3, needconvert),
612 : : needconvert);
613 : 384 : res = m2convert_BuildConvert (
614 : 384 : location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, false);
615 : 384 : m2statement_BuildAssignmentTree (location, op1, res);
616 : 384 : m2statement_DeclareLabel (location, labelEndName);
617 : : }
618 : 516 : }
619 : :
620 : : /* BuildLRL builds and returns tree (op1 rotate left by op2 bits). */
621 : :
622 : : tree
623 : 0 : m2expr_BuildLRL (location_t location, tree op1, tree op2, bool needconvert)
624 : : {
625 : 0 : tree t;
626 : :
627 : 0 : m2assert_AssertLocation (location);
628 : :
629 : 0 : op1 = m2expr_FoldAndStrip (op1);
630 : 0 : op2 = m2expr_FoldAndStrip (op2);
631 : :
632 : 0 : t = m2expr_build_binary_op (location, LROTATE_EXPR, op1, op2, needconvert);
633 : 0 : return m2expr_FoldAndStrip (t);
634 : : }
635 : :
636 : : /* BuildLRR builds and returns tree (op1 rotate right by op2 bits). */
637 : :
638 : : tree
639 : 0 : m2expr_BuildLRR (location_t location, tree op1, tree op2, bool needconvert)
640 : : {
641 : 0 : tree t;
642 : :
643 : 0 : m2assert_AssertLocation (location);
644 : :
645 : 0 : op1 = m2expr_FoldAndStrip (op1);
646 : 0 : op2 = m2expr_FoldAndStrip (op2);
647 : :
648 : 0 : t = m2expr_build_binary_op (location, RROTATE_EXPR, op1, op2, needconvert);
649 : 0 : return m2expr_FoldAndStrip (t);
650 : : }
651 : :
652 : : /* m2expr_BuildMask returns a tree for the mask of a set of nBits.
653 : : It assumes nBits is <= TSIZE (WORD). */
654 : :
655 : : tree
656 : 196 : m2expr_BuildMask (location_t location, tree nBits, bool needconvert)
657 : : {
658 : 196 : tree mask = m2expr_BuildLSL (location, m2expr_GetIntegerOne (location),
659 : : nBits, needconvert);
660 : 196 : m2assert_AssertLocation (location);
661 : 196 : return m2expr_BuildSub (location, mask, m2expr_GetIntegerOne (location),
662 : 196 : needconvert);
663 : : }
664 : :
665 : : /* m2expr_BuildLRotate returns a tree in which op1 has been left
666 : : rotated by nBits. It assumes nBits is <= TSIZE (WORD). */
667 : :
668 : : tree
669 : 74 : m2expr_BuildLRotate (location_t location, tree op1, tree nBits,
670 : : bool needconvert)
671 : : {
672 : 74 : tree t;
673 : :
674 : 74 : op1 = m2expr_FoldAndStrip (op1);
675 : 74 : nBits = m2expr_FoldAndStrip (nBits);
676 : 74 : nBits = m2convert_BuildConvert (location, TREE_TYPE (op1), nBits, needconvert);
677 : 74 : t = m2expr_build_binary_op (location, LROTATE_EXPR, op1, nBits, needconvert);
678 : 74 : return m2expr_FoldAndStrip (t);
679 : : }
680 : :
681 : : /* m2expr_BuildRRotate returns a tree in which op1 has been left
682 : : rotated by nBits. It assumes nBits is <= TSIZE (WORD). */
683 : :
684 : : tree
685 : 74 : m2expr_BuildRRotate (location_t location, tree op1, tree nBits,
686 : : bool needconvert)
687 : : {
688 : 74 : tree t;
689 : :
690 : 74 : op1 = m2expr_FoldAndStrip (op1);
691 : 74 : nBits = m2expr_FoldAndStrip (nBits);
692 : 74 : nBits = m2convert_BuildConvert (location, TREE_TYPE (op1), nBits, needconvert);
693 : 74 : t = m2expr_build_binary_op (location, RROTATE_EXPR, op1, nBits, needconvert);
694 : 74 : return m2expr_FoldAndStrip (t);
695 : : }
696 : :
697 : : /* BuildLRLn builds and returns tree (op1 rotate left by op2 bits) it
698 : : rotates a set of size, nBits. */
699 : :
700 : : tree
701 : 220 : m2expr_BuildLRLn (location_t location, tree op1, tree op2, tree nBits,
702 : : bool needconvert)
703 : : {
704 : 220 : tree op2min;
705 : :
706 : 220 : m2assert_AssertLocation (location);
707 : :
708 : : /* Ensure we wrap the rotate. */
709 : :
710 : 220 : op2min = m2expr_BuildModTrunc (
711 : : location, m2convert_ToCardinal (location, op2),
712 : : m2convert_ToCardinal (location, nBits), needconvert);
713 : :
714 : : /* Optimize if we are we going to rotate a TSIZE(BITSET) set. */
715 : :
716 : 220 : if (m2expr_CompareTrees (
717 : : m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset ()), nBits)
718 : : == 0)
719 : 74 : return m2expr_BuildLRotate (location, op1, op2min, needconvert);
720 : : else
721 : : {
722 : 146 : tree mask = m2expr_BuildMask (location, nBits, needconvert);
723 : 146 : tree left, right;
724 : :
725 : : /* Make absolutely sure there are no high order bits lying around. */
726 : :
727 : 146 : op1 = m2expr_BuildLogicalAnd (location, op1, mask, needconvert);
728 : 146 : left = m2expr_BuildLSL (location, op1, op2min, needconvert);
729 : 146 : left = m2expr_BuildLogicalAnd (location, left, mask, needconvert);
730 : 146 : right = m2expr_BuildLSR (
731 : : location, op1,
732 : : m2expr_BuildSub (location, m2convert_ToCardinal (location, nBits),
733 : : op2min, needconvert),
734 : : needconvert);
735 : 146 : return m2expr_BuildLogicalOr (location, left, right, needconvert);
736 : : }
737 : : }
738 : :
739 : : /* BuildLRRn builds and returns tree (op1 rotate right by op2 bits).
740 : : It rotates a set of size, nBits. */
741 : :
742 : : tree
743 : 124 : m2expr_BuildLRRn (location_t location, tree op1, tree op2, tree nBits,
744 : : bool needconvert)
745 : : {
746 : 124 : tree op2min;
747 : :
748 : 124 : m2assert_AssertLocation (location);
749 : :
750 : : /* Ensure we wrap the rotate. */
751 : :
752 : 124 : op2min = m2expr_BuildModTrunc (
753 : : location, m2convert_ToCardinal (location, op2),
754 : : m2convert_ToCardinal (location, nBits), needconvert);
755 : : /* Optimize if we are we going to rotate a TSIZE(BITSET) set. */
756 : :
757 : 124 : if (m2expr_CompareTrees (
758 : : m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset ()), nBits)
759 : : == 0)
760 : 74 : return m2expr_BuildRRotate (location, op1, op2min, needconvert);
761 : : else
762 : : {
763 : 50 : tree mask = m2expr_BuildMask (location, nBits, needconvert);
764 : 50 : tree left, right;
765 : :
766 : : /* Make absolutely sure there are no high order bits lying around. */
767 : :
768 : 50 : op1 = m2expr_BuildLogicalAnd (location, op1, mask, needconvert);
769 : 50 : right = m2expr_BuildLSR (location, op1, op2min, needconvert);
770 : 50 : left = m2expr_BuildLSL (
771 : : location, op1,
772 : : m2expr_BuildSub (location, m2convert_ToCardinal (location, nBits),
773 : : op2min, needconvert),
774 : : needconvert);
775 : 50 : left = m2expr_BuildLogicalAnd (location, left, mask, needconvert);
776 : 50 : return m2expr_BuildLogicalOr (location, left, right, needconvert);
777 : : }
778 : : }
779 : :
780 : : /* BuildLogicalRotate build the ISO Modula-2 ROTATE operator for a
781 : : fundamental data type. */
782 : :
783 : : void
784 : 274 : m2expr_BuildLogicalRotate (location_t location, tree op1, tree op2, tree op3,
785 : : tree nBits, bool needconvert)
786 : : {
787 : 274 : tree res;
788 : :
789 : 274 : m2assert_AssertLocation (location);
790 : 274 : op2 = m2expr_FoldAndStrip (op2);
791 : 274 : op3 = m2expr_FoldAndStrip (op3);
792 : 274 : if (TREE_CODE (op3) == INTEGER_CST)
793 : : {
794 : 204 : if (tree_int_cst_sgn (op3) < 0)
795 : 54 : res = m2expr_BuildLRRn (
796 : : location, op2, m2expr_BuildNegate (location, op3, needconvert),
797 : : nBits, needconvert);
798 : : else
799 : 150 : res = m2expr_BuildLRLn (location, op2, op3, nBits, needconvert);
800 : 204 : m2statement_BuildAssignmentTree (location, op1, res);
801 : : }
802 : : else
803 : : {
804 : 70 : char *labelElseName = createUniqueLabel ();
805 : 70 : char *labelEndName = createUniqueLabel ();
806 : 70 : tree rotateCount = m2convert_ToInteger (location, op3);
807 : 70 : tree is_less = m2expr_BuildLessThan (location, rotateCount,
808 : : m2expr_GetIntegerZero (location));
809 : :
810 : 70 : m2statement_DoJump (location, is_less, NULL, labelElseName);
811 : 70 : res = m2expr_BuildLRLn (location, op2, rotateCount, nBits, needconvert);
812 : 70 : m2statement_BuildAssignmentTree (location, op1, res);
813 : 70 : m2statement_BuildGoto (location, labelEndName);
814 : 70 : m2statement_DeclareLabel (location, labelElseName);
815 : 70 : rotateCount = m2expr_BuildNegate (location, rotateCount, needconvert);
816 : 70 : res = m2expr_BuildLRRn (location, op2, rotateCount, nBits, needconvert);
817 : 70 : m2statement_BuildAssignmentTree (location, op1, res);
818 : 70 : m2statement_DeclareLabel (location, labelEndName);
819 : : }
820 : 274 : }
821 : :
822 : : /* buildUnboundedArrayOf construct an unbounded struct and returns
823 : : the gcc tree. The two fields of the structure are initialized to
824 : : contentsPtr and high. */
825 : :
826 : : static tree
827 : 576 : buildUnboundedArrayOf (tree unbounded, tree contentsPtr, tree high)
828 : : {
829 : 576 : tree fields = TYPE_FIELDS (unbounded);
830 : 576 : tree field_list = NULL_TREE;
831 : 576 : tree constructor;
832 : :
833 : 576 : field_list = tree_cons (fields, contentsPtr, field_list);
834 : 576 : fields = TREE_CHAIN (fields);
835 : :
836 : 576 : field_list = tree_cons (fields, high, field_list);
837 : :
838 : 576 : constructor = build_constructor_from_list (unbounded, nreverse (field_list));
839 : 576 : TREE_CONSTANT (constructor) = 0;
840 : 576 : TREE_STATIC (constructor) = 0;
841 : :
842 : 576 : return constructor;
843 : : }
844 : :
845 : : /* BuildBinarySetDo if the size of the set is <= TSIZE(WORD) then op1
846 : : := binop(op2, op3) else call m2rtsprocedure(op1, op2, op3). */
847 : :
848 : : void
849 : 1078 : m2expr_BuildBinarySetDo (location_t location, tree settype, tree op1, tree op2,
850 : : tree op3, void (*binop) (location_t, tree, tree, tree,
851 : : tree, bool),
852 : : bool is_op1lvalue, bool is_op2lvalue, bool is_op3lvalue,
853 : : tree nBits, tree unbounded, tree varproc,
854 : : tree leftproc, tree rightproc)
855 : : {
856 : 1078 : tree size = m2expr_GetSizeOf (location, settype);
857 : 1078 : bool is_const = false;
858 : 1078 : bool is_left = false;
859 : :
860 : 1078 : m2assert_AssertLocation (location);
861 : :
862 : 1078 : ASSERT_BOOL (is_op1lvalue);
863 : 1078 : ASSERT_BOOL (is_op2lvalue);
864 : 1078 : ASSERT_BOOL (is_op3lvalue);
865 : :
866 : 1078 : if (m2expr_CompareTrees (
867 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
868 : : <= 0)
869 : : /* Small set size <= TSIZE(WORD). */
870 : 790 : (*binop) (location,
871 : : m2treelib_get_rvalue (location, op1, settype, is_op1lvalue),
872 : : m2treelib_get_rvalue (location, op2, settype, is_op2lvalue),
873 : : m2treelib_get_rvalue (location, op3, settype, is_op3lvalue),
874 : : nBits, false);
875 : : else
876 : : {
877 : 288 : tree result;
878 : 288 : tree high = m2expr_BuildSub (
879 : : location,
880 : : m2convert_ToCardinal (
881 : : location,
882 : : m2expr_BuildDivTrunc (
883 : : location, size,
884 : : m2expr_GetSizeOf (location, m2type_GetBitsetType ()),
885 : : false)),
886 : : m2expr_GetCardinalOne (location), false);
887 : :
888 : : /* If op3 is constant then make op3 positive and remember which
889 : : direction we are shifting. */
890 : :
891 : 288 : op3 = m2tree_skip_const_decl (op3);
892 : 288 : if (TREE_CODE (op3) == INTEGER_CST)
893 : : {
894 : 192 : is_const = true;
895 : 192 : if (tree_int_cst_sgn (op3) < 0)
896 : 108 : op3 = m2expr_BuildNegate (location, op3, false);
897 : : else
898 : : is_left = true;
899 : 192 : op3 = m2convert_BuildConvert (location, m2type_GetM2CardinalType (),
900 : : op3, false);
901 : : }
902 : :
903 : : /* These parameters must match the prototypes of the procedures:
904 : : ShiftLeft, ShiftRight, ShiftVal, RotateLeft, RotateRight, RotateVal
905 : : inside gm2-iso/SYSTEM.mod. */
906 : :
907 : : /* Remember we must build the parameters in reverse. */
908 : :
909 : : /* Parameter 4 amount. */
910 : 288 : m2statement_BuildParam (
911 : : location,
912 : : m2convert_BuildConvert (
913 : : location, m2type_GetM2IntegerType (),
914 : : m2treelib_get_rvalue (location, op3,
915 : 288 : m2tree_skip_type_decl (TREE_TYPE (op3)),
916 : : is_op3lvalue),
917 : : false));
918 : :
919 : : /* Parameter 3 nBits. */
920 : 288 : m2statement_BuildParam (
921 : : location,
922 : : m2convert_BuildConvert (location, m2type_GetM2CardinalType (),
923 : : m2expr_FoldAndStrip (nBits), false));
924 : :
925 : : /* Parameter 2 destination set. */
926 : 288 : m2statement_BuildParam (
927 : : location,
928 : : buildUnboundedArrayOf (
929 : : unbounded,
930 : : m2treelib_get_set_address (location, op1, is_op1lvalue), high));
931 : :
932 : : /* Parameter 1 source set. */
933 : 288 : m2statement_BuildParam (
934 : : location,
935 : : buildUnboundedArrayOf (
936 : : unbounded,
937 : : m2treelib_get_set_address (location, op2, is_op2lvalue), high));
938 : :
939 : : /* Now call the appropriate procedure inside SYSTEM.mod. */
940 : 288 : if (is_const)
941 : 192 : if (is_left)
942 : 84 : result = m2statement_BuildProcedureCallTree (location, leftproc,
943 : : NULL_TREE);
944 : : else
945 : 108 : result = m2statement_BuildProcedureCallTree (location, rightproc,
946 : : NULL_TREE);
947 : : else
948 : 96 : result = m2statement_BuildProcedureCallTree (location, varproc,
949 : : NULL_TREE);
950 : 288 : add_stmt (location, result);
951 : : }
952 : 1078 : }
953 : :
954 : : /* Print a warning if a constant expression had overflow in folding.
955 : : Invoke this function on every expression that the language requires
956 : : to be a constant expression. */
957 : :
958 : : void
959 : 49647 : m2expr_ConstantExpressionWarning (tree value)
960 : : {
961 : 1148 : if ((TREE_CODE (value) == INTEGER_CST || TREE_CODE (value) == REAL_CST
962 : 638 : || TREE_CODE (value) == FIXED_CST || TREE_CODE (value) == VECTOR_CST
963 : 638 : || TREE_CODE (value) == COMPLEX_CST)
964 : 50451 : && TREE_OVERFLOW (value))
965 : 0 : pedwarn (input_location, OPT_Woverflow, "overflow in constant expression");
966 : 49647 : }
967 : :
968 : : /* TreeOverflow return true if the contant expression, t, has caused
969 : : an overflow. No error message or warning is emitted and no
970 : : modification is made to, t. */
971 : :
972 : : bool
973 : 4493964 : m2expr_TreeOverflow (tree t)
974 : : {
975 : 4493964 : if ((TREE_CODE (t) == INTEGER_CST
976 : 48352 : || (TREE_CODE (t) == COMPLEX_CST
977 : 618 : && TREE_CODE (TREE_REALPART (t)) == INTEGER_CST))
978 : 4493964 : && TREE_OVERFLOW (t))
979 : : return true;
980 : 4493952 : else if ((TREE_CODE (t) == REAL_CST
981 : 4492950 : || (TREE_CODE (t) == COMPLEX_CST
982 : 618 : && TREE_CODE (TREE_REALPART (t)) == REAL_CST))
983 : 4494570 : && TREE_OVERFLOW (t))
984 : 0 : return true;
985 : : else
986 : : return false;
987 : : }
988 : :
989 : : /* RemoveOverflow if tree, t, is a constant expression it removes any
990 : : overflow flag and returns, t. */
991 : :
992 : : tree
993 : 9613 : m2expr_RemoveOverflow (tree t)
994 : : {
995 : 9613 : if (TREE_CODE (t) == INTEGER_CST
996 : 9613 : || (TREE_CODE (t) == COMPLEX_CST
997 : 0 : && TREE_CODE (TREE_REALPART (t)) == INTEGER_CST))
998 : 0 : TREE_OVERFLOW (t) = 0;
999 : 9613 : else if (TREE_CODE (t) == REAL_CST
1000 : 9613 : || (TREE_CODE (t) == COMPLEX_CST
1001 : 0 : && TREE_CODE (TREE_REALPART (t)) == REAL_CST))
1002 : 0 : TREE_OVERFLOW (t) = 0;
1003 : 9613 : return t;
1004 : : }
1005 : :
1006 : : /* BuildCoerce return a tree containing the expression, expr, after
1007 : : it has been coersed to, type. */
1008 : :
1009 : : tree
1010 : 0 : m2expr_BuildCoerce (location_t location, tree des, tree type, tree expr)
1011 : : {
1012 : 0 : tree copy = copy_node (expr);
1013 : 0 : TREE_TYPE (copy) = type;
1014 : :
1015 : 0 : m2assert_AssertLocation (location);
1016 : :
1017 : 0 : return m2treelib_build_modify_expr (location, des, NOP_EXPR, copy);
1018 : : }
1019 : :
1020 : : /* BuildTrunc return an integer expression from a REAL or LONGREAL op1. */
1021 : :
1022 : : tree
1023 : 0 : m2expr_BuildTrunc (tree op1)
1024 : : {
1025 : 0 : return convert_to_integer (m2type_GetIntegerType (),
1026 : 0 : m2expr_FoldAndStrip (op1));
1027 : : }
1028 : :
1029 : : /* checkUnaryWholeOverflow decide if we can check this unary expression. */
1030 : :
1031 : : tree
1032 : 748 : m2expr_checkUnaryWholeOverflow (location_t location, enum tree_code code,
1033 : : tree arg, tree lowest, tree min, tree max)
1034 : : {
1035 : 748 : if (M2Options_GetWholeValueCheck () && (min != NULL))
1036 : : {
1037 : 96 : lowest = m2tree_skip_type_decl (lowest);
1038 : 96 : arg = fold_convert_loc (location, lowest, arg);
1039 : :
1040 : 96 : switch (code)
1041 : : {
1042 : 96 : case NEGATE_EXPR:
1043 : 96 : return checkWholeNegateOverflow (location, arg, lowest, min, max);
1044 : : default:
1045 : : return NULL;
1046 : : }
1047 : : }
1048 : : return NULL;
1049 : : }
1050 : :
1051 : : /* build_unary_op return a unary tree node. */
1052 : :
1053 : : tree
1054 : 812 : m2expr_build_unary_op_check (location_t location, enum tree_code code,
1055 : : tree arg, tree lowest, tree min, tree max)
1056 : : {
1057 : 812 : tree argtype = TREE_TYPE (arg);
1058 : 812 : tree result;
1059 : 812 : tree check = NULL;
1060 : :
1061 : 812 : m2assert_AssertLocation (location);
1062 : :
1063 : 812 : arg = m2expr_FoldAndStrip (arg);
1064 : :
1065 : 812 : if ((TREE_CODE (argtype) != REAL_TYPE) && (min != NULL))
1066 : 748 : check = m2expr_checkUnaryWholeOverflow (location, code, arg, lowest, min, max);
1067 : :
1068 : 812 : result = build1 (code, argtype, arg);
1069 : 812 : protected_set_expr_location (result, location);
1070 : :
1071 : 812 : if (check != NULL)
1072 : 96 : result = build2 (COMPOUND_EXPR, argtype, check, result);
1073 : :
1074 : 812 : if (SCALAR_FLOAT_TYPE_P (argtype))
1075 : 64 : m2expr_checkRealOverflow (location, code, result);
1076 : :
1077 : 812 : return m2expr_FoldAndStrip (result);
1078 : : }
1079 : :
1080 : : /* build_unary_op return a unary tree node. */
1081 : :
1082 : : tree
1083 : 24768 : m2expr_build_unary_op (location_t location, enum tree_code code, tree arg,
1084 : : int flag ATTRIBUTE_UNUSED)
1085 : : {
1086 : 24768 : tree argtype = TREE_TYPE (arg);
1087 : 24768 : tree result;
1088 : :
1089 : 24768 : m2assert_AssertLocation (location);
1090 : :
1091 : 24768 : arg = m2expr_FoldAndStrip (arg);
1092 : 24768 : result = build1 (code, argtype, arg);
1093 : 24768 : protected_set_expr_location (result, location);
1094 : :
1095 : 24768 : return m2expr_FoldAndStrip (result);
1096 : : }
1097 : :
1098 : : /* build_binary_op is a heavily pruned version of the one found in
1099 : : c-typeck.cc. The Modula-2 expression rules are much more restricted
1100 : : than C. */
1101 : :
1102 : : tree
1103 : 2086688 : build_binary_op (location_t location, enum tree_code code, tree op1, tree op2,
1104 : : int convert ATTRIBUTE_UNUSED)
1105 : : {
1106 : 2086688 : tree type1 = TREE_TYPE (op1);
1107 : 2086688 : tree result;
1108 : :
1109 : 2086688 : m2assert_AssertLocation (location);
1110 : :
1111 : : /* Strip NON_LVALUE_EXPRs, etc., since we aren't using as an lvalue. */
1112 : 4179564 : STRIP_TYPE_NOPS (op1);
1113 : 2086808 : STRIP_TYPE_NOPS (op2);
1114 : :
1115 : 2086688 : op1 = m2expr_FoldAndStrip (op1);
1116 : 2086688 : op2 = m2expr_FoldAndStrip (op2);
1117 : :
1118 : 2086688 : result = build2 (code, type1, op1, op2);
1119 : 2086688 : protected_set_expr_location (result, location);
1120 : :
1121 : 2086688 : return m2expr_FoldAndStrip (result);
1122 : : }
1123 : :
1124 : : /* BuildLessThanZero - returns a tree containing (< value 0). It
1125 : : checks the min and max value to ensure that the test can be safely
1126 : : achieved and will short circuit the result otherwise. */
1127 : :
1128 : : tree
1129 : 5536 : m2expr_BuildLessThanZero (location_t location, tree value, tree type, tree min,
1130 : : tree max)
1131 : : {
1132 : 5536 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) >= 0)
1133 : : /* min is greater than or equal to zero therefore value will always
1134 : : be >= 0. */
1135 : 3164 : return m2type_GetBooleanFalse ();
1136 : 2372 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) == -1)
1137 : : /* max is less than zero therefore value will always be < 0. */
1138 : 0 : return m2type_GetBooleanTrue ();
1139 : : /* We now know 0 lies in the range min..max so we can safely cast
1140 : : zero to type. */
1141 : 2372 : return m2expr_BuildLessThan (
1142 : : location, value,
1143 : 2372 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1144 : : }
1145 : :
1146 : : /* BuildGreaterThanZero - returns a tree containing (> value 0). It
1147 : : checks the min and max value to ensure that the test can be safely
1148 : : achieved and will short circuit the result otherwise. */
1149 : :
1150 : : tree
1151 : 4844 : m2expr_BuildGreaterThanZero (location_t location, tree value, tree type,
1152 : : tree min, tree max)
1153 : : {
1154 : 4844 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
1155 : : /* min is greater than zero therefore value will always be > 0. */
1156 : 40 : return m2type_GetBooleanTrue ();
1157 : 4804 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) <= 0)
1158 : : /* max is less than or equal to zero therefore value will always be
1159 : : <= 0. */
1160 : 36 : return m2type_GetBooleanFalse ();
1161 : : /* We now know 0 lies in the range min..max so we can safely cast
1162 : : zero to type. */
1163 : 4768 : return m2expr_BuildGreaterThan (
1164 : : location, value,
1165 : 4768 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1166 : : }
1167 : :
1168 : : /* BuildEqualToZero - returns a tree containing (= value 0). It
1169 : : checks the min and max value to ensure that the test can be safely
1170 : : achieved and will short circuit the result otherwise. */
1171 : :
1172 : : tree
1173 : 1392 : m2expr_BuildEqualToZero (location_t location, tree value, tree type, tree min,
1174 : : tree max)
1175 : : {
1176 : 1392 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
1177 : : /* min is greater than zero therefore value will always be > 0. */
1178 : 44 : return m2type_GetBooleanFalse ();
1179 : 1348 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
1180 : : /* max is less than or equal to zero therefore value will always be <
1181 : : 0. */
1182 : 0 : return m2type_GetBooleanFalse ();
1183 : : /* We now know 0 lies in the range min..max so we can safely cast
1184 : : zero to type. */
1185 : 1348 : return m2expr_BuildEqualTo (
1186 : : location, value,
1187 : 1348 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1188 : : }
1189 : :
1190 : : /* BuildNotEqualToZero - returns a tree containing (# value 0). It
1191 : : checks the min and max value to ensure that the test can be safely
1192 : : achieved and will short circuit the result otherwise. */
1193 : :
1194 : : tree
1195 : 1136 : m2expr_BuildNotEqualToZero (location_t location, tree value, tree type,
1196 : : tree min, tree max)
1197 : : {
1198 : 1136 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
1199 : : /* min is greater than zero therefore value will always be true. */
1200 : 32 : return m2type_GetBooleanTrue ();
1201 : 1104 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
1202 : : /* max is less than or equal to zero therefore value will always be
1203 : : true. */
1204 : 0 : return m2type_GetBooleanTrue ();
1205 : : /* We now know 0 lies in the range min..max so we can safely cast
1206 : : zero to type. */
1207 : 1104 : return m2expr_BuildNotEqualTo (
1208 : : location, value,
1209 : 1104 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1210 : : }
1211 : :
1212 : :
1213 : : /* BuildGreaterThanOrEqualZero - returns a tree containing (>= value 0). It
1214 : : checks the min and max value to ensure that the test can be safely
1215 : : achieved and will short circuit the result otherwise. */
1216 : :
1217 : : tree
1218 : 96 : m2expr_BuildGreaterThanOrEqualZero (location_t location, tree value, tree type,
1219 : : tree min, tree max)
1220 : : {
1221 : 96 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) >= 0)
1222 : : /* min is greater than or equal to zero therefore value will always be >= 0. */
1223 : 48 : return m2type_GetBooleanTrue ();
1224 : 48 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
1225 : : /* max is less than zero therefore value will always be < 0. */
1226 : 0 : return m2type_GetBooleanFalse ();
1227 : : /* We now know 0 lies in the range min..max so we can safely cast
1228 : : zero to type. */
1229 : 48 : return m2expr_BuildGreaterThan (
1230 : : location, value,
1231 : 48 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1232 : : }
1233 : :
1234 : :
1235 : : /* BuildLessThanOrEqualZero - returns a tree containing (<= value 0). It
1236 : : checks the min and max value to ensure that the test can be safely
1237 : : achieved and will short circuit the result otherwise. */
1238 : :
1239 : : tree
1240 : 296 : m2expr_BuildLessThanOrEqualZero (location_t location, tree value, tree type,
1241 : : tree min, tree max)
1242 : : {
1243 : 296 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) > 0)
1244 : : /* min is greater than zero therefore value will always be > 0. */
1245 : 8 : return m2type_GetBooleanFalse ();
1246 : 288 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) <= 0)
1247 : : /* max is less than or equal to zero therefore value will always be <= 0. */
1248 : 0 : return m2type_GetBooleanTrue ();
1249 : : /* We now know 0 lies in the range min..max so we can safely cast
1250 : : zero to type. */
1251 : 288 : return m2expr_BuildLessThanOrEqual (
1252 : : location, value,
1253 : 288 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1254 : : }
1255 : :
1256 : :
1257 : : /* get_current_function_name, return the name of the current function if
1258 : : it currently exists. NULL is returned if we are not inside a function. */
1259 : :
1260 : : static const char *
1261 : 3712 : get_current_function_name (void)
1262 : : {
1263 : 3712 : if (current_function_decl != NULL
1264 : 3712 : && (DECL_NAME (current_function_decl) != NULL)
1265 : 7424 : && (IDENTIFIER_POINTER (DECL_NAME (current_function_decl)) != NULL))
1266 : 3712 : return IDENTIFIER_POINTER (DECL_NAME (current_function_decl));
1267 : : return NULL;
1268 : : }
1269 : :
1270 : : /* checkWholeNegateOverflow - check to see whether -arg will overflow
1271 : : an integer.
1272 : :
1273 : : PROCEDURE sneg (i: INTEGER) ;
1274 : : BEGIN
1275 : : IF i = MIN(INTEGER)
1276 : : THEN
1277 : : 'integer overflow'
1278 : : END
1279 : : END sneg ;
1280 : :
1281 : : general purpose subrange type, i, is currently legal, min is
1282 : : MIN(type) and max is MAX(type).
1283 : :
1284 : : PROCEDURE sneg (i: type) ;
1285 : : BEGIN
1286 : : max := MAX (type) ;
1287 : : min := MIN (type) ;
1288 : : (* cannot overflow if i is 0 *)
1289 : : IF (i#0) AND
1290 : : (* will overflow if entire range is positive. *)
1291 : : ((min >= 0) OR
1292 : : (* will overflow if entire range is negative. *)
1293 : : (max <= 0) OR
1294 : : (* c7 and c8 and c9 and c10 -> c17 more units positive. *)
1295 : : ((min < 0) AND (max > 0) AND ((min + max) > 0) AND (i > -min)) OR
1296 : : (* c11 and c12 and c13 and c14 -> c18 more units negative. *)
1297 : : ((min < 0) AND (max > 0) AND ((min + max) < 0) AND (i < -max)))
1298 : : THEN
1299 : : 'type overflow'
1300 : : END
1301 : : END sneg ; */
1302 : :
1303 : : static tree
1304 : 96 : checkWholeNegateOverflow (location_t location,
1305 : : tree i, tree type, tree min,
1306 : : tree max)
1307 : : {
1308 : 96 : tree a1
1309 : 96 : = m2expr_BuildNotEqualToZero (location, i, type, min, max); /* i # 0. */
1310 : 96 : tree c1 = m2expr_BuildGreaterThanZero (location, min, type, min,
1311 : : max); /* min > 0. */
1312 : 96 : tree c2 = m2expr_BuildEqualToZero (location, min, type, min,
1313 : : max); /* min == 0. */
1314 : 96 : tree c4 = m2expr_BuildLessThanZero (location, max, type, min,
1315 : : max); /* max < 0. */
1316 : 96 : tree c5 = m2expr_BuildEqualToZero (location, max, type, min,
1317 : : max); /* max == 0. */
1318 : 96 : tree c7 = m2expr_BuildLessThanZero (location, min, type, min,
1319 : : max); /* min < 0. */
1320 : 96 : tree c8 = m2expr_BuildGreaterThanZero (location, max, type, min,
1321 : : max); /* max > 0. */
1322 : 96 : tree c9 = m2expr_BuildGreaterThanZero (
1323 : : location, m2expr_BuildAdd (location, min, max, false), type, min,
1324 : : max); /* min + max > 0. */
1325 : 96 : tree c10 = m2expr_BuildGreaterThan (
1326 : : location, i, m2expr_BuildNegate (location, min, false)); /* i > -min. */
1327 : 96 : tree c11 = m2expr_BuildLessThanZero (
1328 : : location, m2expr_BuildAdd (location, min, max, false), type, min,
1329 : : max); /* min + max < 0. */
1330 : 96 : tree c12 = m2expr_BuildLessThan (
1331 : : location, i, m2expr_BuildNegate (location, max, false)); /* i < -max. */
1332 : :
1333 : 96 : tree b1 = m2expr_BuildTruthOrIf (location, c1, c2);
1334 : 96 : tree b2 = m2expr_BuildTruthOrIf (location, c8, c5);
1335 : 96 : tree o1 = m2expr_BuildTruthAndIf (location, b1, b2);
1336 : :
1337 : 96 : tree b3 = m2expr_BuildTruthOrIf (location, c7, c2);
1338 : 96 : tree b4 = m2expr_BuildTruthOrIf (location, c4, c5);
1339 : 96 : tree o2 = m2expr_BuildTruthAndIf (location, b3, b4);
1340 : :
1341 : 96 : tree o3 = m2expr_Build4TruthAndIf (location, c7, c8, c9, c10);
1342 : 96 : tree o4 = m2expr_Build4TruthAndIf (location, c7, c8, c11, c12);
1343 : :
1344 : 96 : tree a2 = m2expr_Build4TruthOrIf (location, o1, o2, o3, o4);
1345 : 96 : tree condition
1346 : 96 : = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, a1, a2));
1347 : :
1348 : 96 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1349 : : get_current_function_name (),
1350 : : "whole value unary minus will cause range overflow");
1351 : 96 : return t;
1352 : : }
1353 : :
1354 : : /* checkWholeAddOverflow - check to see whether op1 + op2 will
1355 : : overflow an integer.
1356 : :
1357 : : PROCEDURE sadd (i, j: INTEGER) ;
1358 : : BEGIN
1359 : : IF ((j>0) AND (i > MAX(INTEGER)-j)) OR ((j<0) AND (i < MIN(INTEGER)-j))
1360 : : THEN
1361 : : 'signed addition overflow'
1362 : : END
1363 : : END sadd. */
1364 : :
1365 : : static tree
1366 : 1504 : checkWholeAddOverflow (location_t location, tree i, tree j, tree lowest,
1367 : : tree min, tree max)
1368 : : {
1369 : 1504 : tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1370 : 1504 : tree i_gt_max_sub_j = m2expr_BuildGreaterThan (
1371 : : location, i, m2expr_BuildSub (location, max, j, false));
1372 : 1504 : tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1373 : 1504 : tree i_lt_min_sub_j = m2expr_BuildLessThan (location, i,
1374 : : m2expr_BuildSub (location, min, j, false));
1375 : 1504 : tree lhs_or = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, j_gt_zero, i_gt_max_sub_j));
1376 : 1504 : tree rhs_or = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, j_lt_zero, i_lt_min_sub_j));
1377 : 1504 : tree condition
1378 : 1504 : = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, lhs_or, rhs_or));
1379 : 1504 : tree result = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1380 : : get_current_function_name (),
1381 : : "whole value addition will cause a range overflow");
1382 : 1504 : return result;
1383 : : }
1384 : :
1385 : : /* checkWholeSubOverflow - check to see whether op1 - op2 will
1386 : : overflow an integer.
1387 : :
1388 : : PROCEDURE ssub (i, j: INTEGER) ;
1389 : : BEGIN
1390 : : IF ((j>0) AND (i < MIN(INTEGER)+j)) OR ((j<0) AND (i > MAX(INTEGER)+j))
1391 : : THEN
1392 : : 'signed subtraction overflow'
1393 : : END
1394 : : END ssub. */
1395 : :
1396 : : static tree
1397 : 956 : checkWholeSubOverflow (location_t location, tree i, tree j, tree lowest,
1398 : : tree min, tree max)
1399 : : {
1400 : 956 : tree c1 = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1401 : 956 : tree c2 = m2expr_BuildLessThan (location, i,
1402 : : m2expr_BuildAdd (location, min, j, false));
1403 : 956 : tree c3 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1404 : 956 : tree c4 = m2expr_BuildGreaterThan (location, i,
1405 : : m2expr_BuildAdd (location, max, j, false));
1406 : 956 : tree c5 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, c1, c2));
1407 : 956 : tree c6 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, c3, c4));
1408 : 956 : tree condition
1409 : 956 : = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, c5, c6));
1410 : 956 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1411 : : get_current_function_name (),
1412 : : "whole value subtraction will cause a range overflow");
1413 : 956 : return t;
1414 : : }
1415 : :
1416 : : /* Build4TruthAndIf - return true if a && b && c && d. Retain order left to
1417 : : * right. */
1418 : :
1419 : : static tree
1420 : 288 : m2expr_Build4TruthAndIf (location_t location, tree a, tree b, tree c, tree d)
1421 : : {
1422 : 288 : tree t1 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, a, b));
1423 : 288 : tree t2 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t1, c));
1424 : 288 : return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t2, d));
1425 : : }
1426 : :
1427 : : /* Build3TruthAndIf - return true if a && b && c. Retain order left to right.
1428 : : */
1429 : :
1430 : : static tree
1431 : 4132 : m2expr_Build3TruthAndIf (location_t location, tree op1, tree op2, tree op3)
1432 : : {
1433 : 4132 : tree t = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, op1, op2));
1434 : 4132 : return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t, op3));
1435 : : }
1436 : :
1437 : : /* Build3TruthOrIf - return true if a || b || c. Retain order left to right.
1438 : : */
1439 : :
1440 : : static tree
1441 : 152 : m2expr_Build3TruthOrIf (location_t location, tree op1, tree op2, tree op3)
1442 : : {
1443 : 152 : tree t = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, op1, op2));
1444 : 152 : return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t, op3));
1445 : : }
1446 : :
1447 : : /* Build4TruthOrIf - return true if op1 || op2 || op3 || op4. Retain order
1448 : : left to right. */
1449 : :
1450 : : static tree
1451 : 900 : m2expr_Build4TruthOrIf (location_t location, tree op1, tree op2, tree op3,
1452 : : tree op4)
1453 : : {
1454 : 900 : tree t1 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, op1, op2));
1455 : 900 : tree t2 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t1, op3));
1456 : 900 : return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t2, op4));
1457 : : }
1458 : :
1459 : : /* Build4LogicalOr - return true if op1 || op2 || op3 || op4. */
1460 : :
1461 : : static tree
1462 : 736 : m2expr_Build4LogicalOr (location_t location, tree op1, tree op2, tree op3,
1463 : : tree op4)
1464 : : {
1465 : 736 : tree t1 = m2expr_FoldAndStrip (
1466 : : m2expr_BuildLogicalOr (location, op1, op2, false));
1467 : 736 : tree t2
1468 : 736 : = m2expr_FoldAndStrip (m2expr_BuildLogicalOr (location, t1, op3, false));
1469 : 736 : return m2expr_FoldAndStrip (
1470 : 736 : m2expr_BuildLogicalOr (location, t2, op4, false));
1471 : : }
1472 : :
1473 : : /* checkWholeMultOverflow - check to see whether i * j will overflow
1474 : : an integer.
1475 : :
1476 : : PROCEDURE smult (lhs, rhs: INTEGER) ;
1477 : : BEGIN
1478 : : IF ((lhs > 0) AND (rhs > 0) AND (lhs > max DIV rhs)) OR
1479 : : ((lhs > 0) AND (rhs < 0) AND (rhs < min DIV lhs)) OR
1480 : : ((lhs < 0) AND (rhs > 0) AND (lhs < min DIV rhs)) OR
1481 : : ((lhs < 0) AND (rhs < 0) AND (lhs < max DIV rhs))
1482 : : THEN
1483 : : error ('signed multiplication overflow')
1484 : : END
1485 : : END smult ;
1486 : :
1487 : : if ((c1 && c3 && c4)
1488 : : || (c1 && c5 && c6)
1489 : : || (c2 && c3 && c7)
1490 : : || (c2 && c5 && c8))
1491 : : error ('signed subtraction overflow'). */
1492 : :
1493 : : static tree
1494 : 736 : testWholeMultOverflow (location_t location, tree lhs, tree rhs,
1495 : : tree lowest, tree min, tree max)
1496 : : {
1497 : 736 : tree c1 = m2expr_BuildGreaterThanZero (location, lhs, lowest, min, max);
1498 : 736 : tree c2 = m2expr_BuildLessThanZero (location, lhs, lowest, min, max);
1499 : :
1500 : 736 : tree c3 = m2expr_BuildGreaterThanZero (location, rhs, lowest, min, max);
1501 : 736 : tree c4 = m2expr_BuildGreaterThan (
1502 : : location, lhs, m2expr_BuildDivTrunc (location, max, rhs, false));
1503 : :
1504 : 736 : tree c5 = m2expr_BuildLessThanZero (location, rhs, lowest, min, max);
1505 : 736 : tree c6 = m2expr_BuildLessThan (
1506 : : location, rhs, m2expr_BuildDivTrunc (location, min, lhs, false));
1507 : 736 : tree c7 = m2expr_BuildLessThan (
1508 : : location, lhs, m2expr_BuildDivTrunc (location, min, rhs, false));
1509 : 736 : tree c8 = m2expr_BuildLessThan (
1510 : : location, lhs, m2expr_BuildDivTrunc (location, max, rhs, false));
1511 : :
1512 : 736 : tree c9 = m2expr_Build3TruthAndIf (location, c1, c3, c4);
1513 : 736 : tree c10 = m2expr_Build3TruthAndIf (location, c1, c5, c6);
1514 : 736 : tree c11 = m2expr_Build3TruthAndIf (location, c2, c3, c7);
1515 : 736 : tree c12 = m2expr_Build3TruthAndIf (location, c2, c5, c8);
1516 : :
1517 : 736 : tree condition = m2expr_Build4LogicalOr (location, c9, c10, c11, c12);
1518 : 736 : return condition;
1519 : : }
1520 : :
1521 : :
1522 : : static tree
1523 : 672 : checkWholeMultOverflow (location_t location, tree i, tree j, tree lowest,
1524 : : tree min, tree max)
1525 : : {
1526 : 672 : tree condition = testWholeMultOverflow (location, i, j, lowest, min, max);
1527 : 672 : tree result = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1528 : : get_current_function_name (),
1529 : : "whole value multiplication will cause a range overflow");
1530 : 672 : return result;
1531 : : }
1532 : :
1533 : :
1534 : : static tree
1535 : 32 : divMinUnderflow (location_t location, tree value, tree lowest, tree min, tree max)
1536 : : {
1537 : 32 : tree min2 = m2expr_BuildMult (location, min, min, false);
1538 : 32 : tree rhs = m2expr_BuildGreaterThanOrEqual (location, value, min2);
1539 : 32 : tree lhs = testWholeMultOverflow (location, min, min, lowest, min, max);
1540 : 32 : return m2expr_BuildTruthAndIf (location, lhs, rhs);
1541 : : }
1542 : :
1543 : : /*
1544 : : divexpr - returns true if a DIV_TRUNC b will overflow.
1545 : : */
1546 : :
1547 : : /* checkWholeDivOverflow - check to see whether i DIV_TRUNC j will overflow
1548 : : an integer. The Modula-2 implementation of the GCC trees follows:
1549 : :
1550 : : PROCEDURE divtruncexpr (a, b: INTEGER) : BOOLEAN ;
1551 : : BEGIN
1552 : : (* Firstly catch division by 0. *)
1553 : : RETURN ((b = 0) OR
1554 : : (* Case 2 range is always negative. *)
1555 : : (* In which case a division will be illegal as result will be positive. *)
1556 : : (max < 0) OR
1557 : : (* Case 1 both min / max are positive, check for underflow. *)
1558 : : ((min >= 0) AND (max >= 0) AND (multMinOverflow (b) OR (a < b * min))) OR
1559 : : (* Case 1 both min / max are positive, check for overflow. *)
1560 : : ((min >= 0) AND (max >= 0) AND (divMinUnderflow (a) OR (b > a DIV min))) OR
1561 : : (* Case 3 mixed range, need to check underflow. *)
1562 : : ((min < 0) AND (max >= 0) AND (a < 0) AND (b < 0) AND (b >= a DIV min)) OR
1563 : : ((min < 0) AND (max >= 0) AND (a < 0) AND (b > 0) AND (b <= a DIV max)) OR
1564 : : ((min < 0) AND (max >= 0) AND (a >= 0) AND (b < 0) AND (a DIV b < min)))
1565 : : END divtruncexpr ;
1566 : :
1567 : : s1 -> a DIV min
1568 : : s2 -> a DIV max
1569 : : s3 -> a DIV b
1570 : :
1571 : : b4 -> (min >= 0) AND (max >= 0)
1572 : : b5 -> (min < 0) AND (max >= 0)
1573 : : a_lt_b_mult_min -> (a < b * min)
1574 : : b_mult_min_overflow -> testWholeMultOverflow (location, b, min, lowest, min, max)
1575 : : b6 -> (b_mult_min_overflow OR a_lt_b_mult_min)
1576 : : b_gt_s1 -> (b > s1)
1577 : : a_div_min_overflow -> divMinUnderflow (location, a, min, lowest, min, max)
1578 : : b7 -> (a_div_min_overflow OR b_gt_s1)
1579 : : b8 -> (a < 0)
1580 : : b9 -> (b < 0)
1581 : : b10 -> (b > 0)
1582 : : b11 -> (b >= s1)
1583 : : b12 -> (b <= s2)
1584 : : b13 -> (s3 < min)
1585 : : b14 -> a >= 0
1586 : :
1587 : : c1 -> (b = 0)
1588 : : c2 -> (max < 0)
1589 : : c3 -> (b4 AND b6)
1590 : : c4 -> (b4 AND b7)
1591 : : c5 -> (b5 AND b8 AND b9 AND b11)
1592 : : c6 -> (b5 AND b8 AND b10 AND b12)
1593 : : c7 -> (b5 AND b14 AND b9 AND b13)
1594 : :
1595 : : if (c1 || c2 || c3 || c4 || c5 || c6 || c7)
1596 : : error ('signed div trunc overflow'). */
1597 : :
1598 : : static tree
1599 : 32 : checkWholeDivTruncOverflow (location_t location, tree i, tree j, tree lowest,
1600 : : tree min, tree max)
1601 : : {
1602 : 32 : tree b4a = m2expr_BuildGreaterThanOrEqualZero (location, min, lowest, min, max);
1603 : 32 : tree b4b = m2expr_BuildGreaterThanOrEqualZero (location, max, lowest, min, max);
1604 : 32 : tree b4 = m2expr_BuildTruthAndIf (location, b4a, b4b);
1605 : 32 : tree b5a = m2expr_BuildLessThanZero (location, min, lowest, min, max);
1606 : 32 : tree b5 = m2expr_BuildTruthAndIf (location, b5a, b4b);
1607 : 32 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
1608 : 32 : tree c2 = m2expr_BuildLessThanZero (location, max, lowest, min, max);
1609 : 32 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, m2expr_BuildMult (location, j, min, false));
1610 : 32 : tree j_mult_min_overflow = testWholeMultOverflow (location, j, min, lowest, min, max);
1611 : 32 : tree b6 = m2expr_BuildTruthOrIf (location, j_mult_min_overflow, i_lt_j_mult_min);
1612 : 32 : tree c3 = m2expr_BuildTruthAndIf (location, b4, b6);
1613 : 32 : tree s1 = m2expr_BuildDivTrunc (location, i, min, false);
1614 : 32 : tree s2 = m2expr_BuildDivTrunc (location, i, max, false);
1615 : 32 : tree s3 = m2expr_BuildDivTrunc (location, i, j, false);
1616 : :
1617 : 32 : tree j_gt_s1 = m2expr_BuildGreaterThan (location, j, s1);
1618 : 32 : tree i_div_min_overflow = divMinUnderflow (location, i, lowest, min, max);
1619 : 32 : tree b7 = m2expr_BuildTruthOrIf (location, i_div_min_overflow, j_gt_s1);
1620 : 32 : tree c4 = m2expr_BuildTruthAndIf (location, b4, b7);
1621 : 32 : tree b8 = m2expr_BuildLessThanZero (location, i, lowest, min, max);
1622 : 32 : tree b9 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1623 : 32 : tree b10 = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1624 : 32 : tree b11 = m2expr_BuildGreaterThanOrEqual (location, j, s1);
1625 : 32 : tree b12 = m2expr_BuildLessThanOrEqual (location, j, s2);
1626 : 32 : tree b13 = m2expr_BuildLessThan (location, s3, min);
1627 : 32 : tree b14 = m2expr_BuildGreaterThanOrEqualZero (location, i, lowest, min, max);
1628 : 32 : tree c5 = m2expr_Build4TruthAndIf (location, b5, b8, b9, b11);
1629 : 32 : tree c6 = m2expr_Build4TruthAndIf (location, b5, b8, b10, b12);
1630 : 32 : tree c7 = m2expr_Build4TruthAndIf (location, b5, b14, b9, b13);
1631 : 32 : tree c8 = m2expr_Build4TruthOrIf (location, c1, c2, c3, c4);
1632 : 32 : tree condition = m2expr_Build4TruthOrIf (location, c5, c6, c7, c8);
1633 : 32 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1634 : : get_current_function_name (),
1635 : : "whole value truncated division will cause a range overflow");
1636 : 32 : return t;
1637 : : }
1638 : :
1639 : : #if 0
1640 : : (*
1641 : : divexpr - returns true if a DIV_CEIL b will overflow.
1642 : : *)
1643 : :
1644 : : (* checkWholeDivCeilOverflow - check to see whether i DIV_CEIL j will overflow
1645 : : an integer. *)
1646 : :
1647 : : PROCEDURE divceilexpr (i, j: INTEGER) : BOOLEAN ;
1648 : : BEGIN
1649 : : RETURN ((j = 0) OR (* division by zero. *)
1650 : : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
1651 : : therefore error. *)
1652 : : ((i # 0) AND (* first operand is legally zero,
1653 : : result is also legally zero. *)
1654 : : divCeilOverflowCases (i, j)))
1655 : : END divceilexpr ;
1656 : :
1657 : :
1658 : : (*
1659 : : divCeilOverflowCases - precondition: i, j are in range values.
1660 : : postcondition: true is returned if i divceil will
1661 : : result in an overflow/underflow.
1662 : : *)
1663 : :
1664 : : PROCEDURE divCeilOverflowCases (i, j: INTEGER) : BOOLEAN ;
1665 : : BEGIN
1666 : : RETURN (((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j)) OR
1667 : : ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j)) OR
1668 : : ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j)) OR
1669 : : ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j)))
1670 : : END divCeilOverflowCases ;
1671 : :
1672 : :
1673 : : (*
1674 : : divCeilOverflowPosPos - precondition: i, j are legal and are both >= 0.
1675 : : postcondition: true is returned if i divceil will
1676 : : result in an overflow/underflow.
1677 : : *)
1678 : :
1679 : : PROCEDURE divCeilOverflowPosPos (i, j: INTEGER) : BOOLEAN ;
1680 : : BEGIN
1681 : : RETURN (((i MOD j = 0) AND (i < j * minT)) OR
1682 : : (((i MOD j # 0) AND (i < j * minT + 1))))
1683 : : END divCeilOverflowPosPos ;
1684 : :
1685 : :
1686 : : (*
1687 : : divCeilOverflowNegNeg - precondition: i, j are in range values and both < 0.
1688 : : postcondition: true is returned if i divceil will
1689 : : result in an overflow/underflow.
1690 : : *)
1691 : :
1692 : : PROCEDURE divCeilOverflowNegNeg (i, j: INTEGER) : BOOLEAN ;
1693 : : BEGIN
1694 : : RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
1695 : : (* check for underflow. *)
1696 : : ((ABS (i) MOD ABS (j) = 0) AND (i >= j * minT)) OR
1697 : : ((ABS (i) MOD ABS (j) # 0) AND (i >= j * minT - 1)) OR
1698 : : (* check for overflow. *)
1699 : : (((ABS (i) MOD maxT) = 0) AND (ABS (i) DIV maxT > ABS (j))) OR
1700 : : (((ABS (i) MOD maxT) # 0) AND (ABS (i) DIV maxT > ABS (j) + 1)))
1701 : : END divCeilOverflowNegNeg ;
1702 : :
1703 : :
1704 : : (*
1705 : : divCeilOverflowNegPos - precondition: i, j are in range values. i < 0, j >= 0.
1706 : : postcondition: true is returned if i divceil will
1707 : : result in an overflow/underflow.
1708 : : *)
1709 : :
1710 : : PROCEDURE divCeilOverflowNegPos (i, j: INTEGER) : BOOLEAN ;
1711 : : BEGIN
1712 : : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
1713 : : We know the result will be negative and therefore we only need to test
1714 : : against minT. *)
1715 : : RETURN (((ABS (i) MOD j = 0) AND (i < j * minT)) OR
1716 : : ((ABS (i) MOD j # 0) AND (i < j * minT - 1)))
1717 : : END divCeilOverflowNegPos ;
1718 : :
1719 : :
1720 : : (*
1721 : : divCeilOverflowPosNeg - precondition: i, j are in range values. i >= 0, j < 0.
1722 : : postcondition: true is returned if i divceil will
1723 : : result in an overflow/underflow.
1724 : : *)
1725 : :
1726 : : PROCEDURE divCeilOverflowPosNeg (i, j: INTEGER) : BOOLEAN ;
1727 : : BEGIN
1728 : : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
1729 : : We know the result will be negative and therefore we only need to test
1730 : : against minT. *)
1731 : : RETURN (((i MOD ABS (j) = 0) AND (i > j * minT)) OR
1732 : : ((i MOD ABS (j) # 0) AND (i > j * minT - 1)))
1733 : : END divCeilOverflowPosNeg ;
1734 : : #endif
1735 : :
1736 : : /* divCeilOverflowPosPos, precondition: lhs, rhs are legal and are both >= 0.
1737 : : Postcondition: TRUE is returned if lhs divceil rhs will result
1738 : : in an overflow/underflow.
1739 : :
1740 : : A handbuilt expression of trees implementing:
1741 : :
1742 : : RETURN (((lhs MOD rhs = 0) AND (min >= 0) AND (lhs < rhs * min)) OR (* check for underflow, no remainder. *)
1743 : : lhs_lt_rhs_mult_min
1744 : : (((lhs MOD rhs # 0) AND (lhs < rhs * min + 1)))) (* check for underflow with remainder. *)
1745 : : ((lhs > min) AND (lhs - 1 > rhs * min))
1746 : : lhs_gt_rhs_mult_min
1747 : :
1748 : : a -> (lhs MOD rhs = 0) AND (lhs < rhs * min)
1749 : : b -> (lhs MOD rhs # 0) AND (lhs < rhs * min + 1)
1750 : : RETURN a OR b. */
1751 : :
1752 : : static tree
1753 : 148 : divCeilOverflowPosPos (location_t location, tree i, tree j, tree lowest,
1754 : : tree min, tree max)
1755 : : {
1756 : 148 : tree i_mod_j = m2expr_BuildModTrunc (location, i, j, false);
1757 : 148 : tree i_mod_j_eq_zero = m2expr_BuildEqualToZero (location, i_mod_j, lowest, min, max);
1758 : 148 : tree i_mod_j_ne_zero = m2expr_BuildNotEqualToZero (location, i_mod_j, lowest, min, max);
1759 : 148 : tree j_min = m2expr_BuildMult (location, j, min, false);
1760 : 148 : tree j_min_1 = m2expr_BuildAdd (location, j_min, m2expr_GetIntegerOne (location), false);
1761 : 148 : tree i_lt_j_min = m2expr_BuildLessThan (location, i, j_min);
1762 : 148 : tree i_lt_j_min_1 = m2expr_BuildLessThan (location, i, j_min_1);
1763 : 148 : tree a = m2expr_BuildTruthAndIf (location, i_mod_j_eq_zero, i_lt_j_min);
1764 : 148 : tree b = m2expr_BuildTruthAndIf (location, i_mod_j_ne_zero, i_lt_j_min_1);
1765 : 148 : return m2expr_BuildTruthOrIf (location, a, b);
1766 : : }
1767 : :
1768 : :
1769 : : /* divCeilOverflowPosNeg precondition: i, j are in range values and i >=0, j < 0.
1770 : : Postcondition: TRUE is returned if i divceil j will result in an
1771 : : overflow/underflow.
1772 : :
1773 : : A handbuilt expression of trees implementing:
1774 : :
1775 : : RETURN (((i MOD ABS (j) = 0) AND (i > j * min)) OR
1776 : : ((i MOD ABS (j) # 0) AND (i > j * min - 1)))
1777 : :
1778 : : abs_j -> (ABS (j))
1779 : : i_mod_abs_j -> (i MOD abs_j)
1780 : : i_mod_abs_j_eq_0 -> (i_mod_abs_j = 0)
1781 : : i_mod_abs_j_ne_0 -> (i_mod_abs_j # 0)
1782 : : j_mult_min -> (j * min)
1783 : : j_mult_min_1 -> (j_mult_min - 1)
1784 : : i_gt_j_mult_min -> (i > j_mult_min)
1785 : : i_gt_j_mult_min_1 -> (i > j_mult_min_1)
1786 : : a -> (i_mod_abs_j_eq_0 AND i_gt_j_mult_min)
1787 : : b -> (i_mod_abs_j_ne_0 AND i_gt_j_mult_min_1)
1788 : : c -> (a OR b). */
1789 : :
1790 : : static tree
1791 : 148 : divCeilOverflowPosNeg (location_t location, tree i, tree j, tree lowest, tree min, tree max)
1792 : : {
1793 : 148 : tree abs_j = m2expr_BuildAbs (location, j);
1794 : 148 : tree i_mod_abs_j = m2expr_BuildModFloor (location, i, abs_j, false);
1795 : 148 : tree i_mod_abs_j_eq_0 = m2expr_BuildEqualToZero (location, i_mod_abs_j, lowest, min, max);
1796 : 148 : tree i_mod_abs_j_ne_0 = m2expr_BuildNotEqualToZero (location, i_mod_abs_j, lowest, min, max);
1797 : 148 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
1798 : 148 : tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
1799 : 148 : tree i_gt_j_mult_min = m2expr_BuildGreaterThan (location, i, j_mult_min);
1800 : 148 : tree i_gt_j_mult_min_1 = m2expr_BuildGreaterThan (location, i, j_mult_min_1);
1801 : 148 : tree a = m2expr_BuildTruthAndIf (location, i_mod_abs_j_eq_0, i_gt_j_mult_min);
1802 : 148 : tree b = m2expr_BuildTruthAndIf (location, i_mod_abs_j_ne_0, i_gt_j_mult_min_1);
1803 : 148 : tree c = m2expr_BuildTruthOrIf (location, a, b);
1804 : 148 : return c;
1805 : : }
1806 : :
1807 : :
1808 : : /* divCeilOverflowNegPos precondition: i, j are in range values and i < 0, j >= 0.
1809 : : Postcondition: TRUE is returned if i divceil j will result in an
1810 : : overflow/underflow.
1811 : :
1812 : : A handbuilt expression of trees implementing:
1813 : :
1814 : : RETURN (((ABS (i) MOD j = 0) AND (i < j * min)) OR
1815 : : ((ABS (i) MOD j # 0) AND (i < j * min - 1)))
1816 : :
1817 : : abs_i -> (ABS (i))
1818 : : abs_i_mod_j -> (abs_i MOD j)
1819 : : abs_i_mod_j_eq_0 -> (abs_i_mod_j = 0)
1820 : : abs_i_mod_j_ne_0 -> (abs_i_mod_j # 0)
1821 : : j_mult_min -> (j * min)
1822 : : j_mult_min_1 -> (j_mult_min - 1)
1823 : : i_lt_j_mult_min -> (i < j_mult_min)
1824 : : i_lt_j_mult_min_1 -> (i < j_mult_min_1)
1825 : : a = (abs_i_mod_j_eq_0 AND i_lt_j_mult_min)
1826 : : b = (abs_i_mod_j_ne_0 AND i_lt_j_mult_min_1)
1827 : : c -> (a OR b). */
1828 : :
1829 : : static tree
1830 : 148 : divCeilOverflowNegPos (location_t location, tree i, tree j, tree lowest, tree min, tree max)
1831 : : {
1832 : 148 : tree abs_i = m2expr_BuildAbs (location, i);
1833 : 148 : tree abs_i_mod_j = m2expr_BuildModFloor (location, abs_i, j, false);
1834 : 148 : tree abs_i_mod_j_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_j, lowest, min, max);
1835 : 148 : tree abs_i_mod_j_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_j, lowest, min, max);
1836 : 148 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
1837 : 148 : tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
1838 : 148 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
1839 : 148 : tree i_lt_j_mult_min_1 = m2expr_BuildLessThan (location, i, j_mult_min_1);
1840 : 148 : tree a = m2expr_BuildTruthAndIf (location, abs_i_mod_j_eq_0, i_lt_j_mult_min);
1841 : 148 : tree b = m2expr_BuildTruthAndIf (location, abs_i_mod_j_ne_0, i_lt_j_mult_min_1);
1842 : 148 : tree c = m2expr_BuildTruthOrIf (location, a, b);
1843 : 148 : return c;
1844 : : }
1845 : :
1846 : :
1847 : : /* divCeilOverflowNegNeg precondition: i, j are in range values and both < 0.
1848 : : Postcondition: TRUE is returned if i divceil j will result in an
1849 : : overflow/underflow.
1850 : :
1851 : : A handbuilt expression of trees implementing:
1852 : :
1853 : : RETURN ((max <= 0) OR (* signs will cause overflow. *)
1854 : : (* check for underflow. *)
1855 : : ((ABS (i) MOD ABS (j) = 0) AND (i >= j * min)) OR
1856 : : ((ABS (i) MOD ABS (j) # 0) AND (i >= j * min - 1)) OR
1857 : : (* check for overflow. *)
1858 : : (((ABS (i) MOD max) = 0) AND (ABS (i) DIV max > ABS (j))) OR
1859 : : (((ABS (i) MOD max) # 0) AND (ABS (i) DIV max > ABS (j) + 1)))
1860 : :
1861 : : max_lte_0 -> (max <= 0)
1862 : : abs_i -> (ABS (i))
1863 : : abs_j -> (ABS (j))
1864 : : abs_i_mod_abs_j -> (abs_i MOD abs_j)
1865 : : abs_i_mod_abs_j_eq_0 -> (abs_i_mod_abs_j = 0)
1866 : : abs_i_mod_abs_j_ne_0 -> (abs_i_mod_abs_j # 0)
1867 : : j_mult_min -> (j * min)
1868 : : j_mult_min_1 -> (j_mult_min - 1)
1869 : : i_ge_j_mult_min -> (i >= j_mult_min)
1870 : : i_ge_j_mult_min_1 -> (i >= j_mult_min_1)
1871 : : abs_i_mod_max -> (abs_i mod max)
1872 : : abs_i_div_max -> (abs_i DIVfloor max)
1873 : : abs_j_1 -> (abs_j + 1)
1874 : : abs_i_mod_max_eq_0 -> (abs_i_mod_max = 0)
1875 : : abs_i_mod_max_ne_0 -> (abs_i_mod_max # 0)
1876 : : abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
1877 : : abs_i_div_max_gt_abs_j_1 -> (abs_i_div_max > abs_j_1)
1878 : :
1879 : : a -> (abs_i_mod_abs_j_eq_0 AND i_ge_j_mult_min)
1880 : : b -> (abs_i_mod_abs_j_ne_0 AND i_ge_j_mult_min_1)
1881 : : c -> (abs_i_mod_max_eq_0 AND abs_i_div_max_gt_abs_j)
1882 : : d -> (abs_i_mod_max_ne_0 AND abs_i_div_max_gt_abs_j_1)
1883 : : e -> (a OR b OR c OR d)
1884 : : return max_lte_0 OR e. */
1885 : :
1886 : : static tree
1887 : 148 : divCeilOverflowNegNeg (location_t location, tree i, tree j, tree lowest,
1888 : : tree min, tree max)
1889 : : {
1890 : 148 : tree max_lte_0 = m2expr_BuildLessThanOrEqualZero (location, max, lowest, min, max);
1891 : 148 : tree abs_i = m2expr_BuildAbs (location, i);
1892 : 148 : tree abs_j = m2expr_BuildAbs (location, j);
1893 : 148 : tree abs_i_mod_abs_j = m2expr_BuildModFloor (location, abs_i, abs_j, false);
1894 : 148 : tree abs_i_mod_abs_j_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_abs_j,
1895 : : lowest, min, max);
1896 : 148 : tree abs_i_mod_abs_j_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_abs_j,
1897 : : lowest, min, max);
1898 : 148 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
1899 : 148 : tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
1900 : 148 : tree i_ge_j_mult_min = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min);
1901 : 148 : tree i_ge_j_mult_min_1 = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min_1);
1902 : 148 : tree abs_i_mod_max = m2expr_BuildModFloor (location, abs_i, max, false);
1903 : 148 : tree abs_i_div_max = m2expr_BuildDivFloor (location, abs_i, max, false);
1904 : 148 : tree abs_j_1 = m2expr_BuildPostInc (location, abs_j);
1905 : 148 : tree abs_i_mod_max_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_max, lowest, min, max);
1906 : 148 : tree abs_i_mod_max_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_max, lowest, min, max);
1907 : 148 : tree abs_i_div_max_gt_abs_j = m2expr_BuildGreaterThan (location, abs_i_div_max, abs_j);
1908 : 148 : tree abs_i_div_max_gt_abs_j_1 = m2expr_BuildGreaterThan (location, abs_i_div_max, abs_j_1);
1909 : :
1910 : 148 : tree a = m2expr_BuildTruthAndIf (location, abs_i_mod_abs_j_eq_0, i_ge_j_mult_min);
1911 : 148 : tree b = m2expr_BuildTruthAndIf (location, abs_i_mod_abs_j_ne_0, i_ge_j_mult_min_1);
1912 : 148 : tree c = m2expr_BuildTruthAndIf (location, abs_i_mod_max_eq_0, abs_i_div_max_gt_abs_j);
1913 : 148 : tree d = m2expr_BuildTruthAndIf (location, abs_i_mod_max_ne_0, abs_i_div_max_gt_abs_j_1);
1914 : 148 : tree e = m2expr_Build4TruthOrIf (location, a, b, c, d);
1915 : 148 : return m2expr_BuildTruthOrIf (location, max_lte_0, e);
1916 : : }
1917 : :
1918 : :
1919 : : /* divCeilOverflowCases, precondition: i, j are in range values.
1920 : : Postcondition: TRUE is returned if i divceil will result in an
1921 : : overflow/underflow.
1922 : :
1923 : : A handbuilt expression of trees implementing:
1924 : :
1925 : : RETURN (((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j)) OR
1926 : : ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j)) OR
1927 : : ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j)) OR
1928 : : ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j)))
1929 : :
1930 : : a -> ((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j))
1931 : : b -> ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j))
1932 : : c -> ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j))
1933 : : d -> ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j))
1934 : :
1935 : : RETURN a AND b AND c AND d. */
1936 : :
1937 : : static tree
1938 : 148 : divCeilOverflowCases (location_t location, tree i, tree j, tree lowest,
1939 : : tree min, tree max)
1940 : : {
1941 : 148 : tree i_gt_zero = m2expr_BuildGreaterThanZero (location, i, lowest, min, max);
1942 : 148 : tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1943 : 148 : tree i_lt_zero = m2expr_BuildLessThanZero (location, i, lowest, min, max);
1944 : 148 : tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1945 : 148 : tree a = m2expr_Build3TruthAndIf (location, i_gt_zero, j_gt_zero,
1946 : : divCeilOverflowPosPos (location, i, j, lowest, min, max));
1947 : 148 : tree b = m2expr_Build3TruthAndIf (location, i_lt_zero, j_lt_zero,
1948 : : divCeilOverflowNegNeg (location, i, j, lowest, min, max));
1949 : 148 : tree c = m2expr_Build3TruthAndIf (location, i_gt_zero, j_lt_zero,
1950 : : divCeilOverflowPosNeg (location, i, j, lowest, min, max));
1951 : 148 : tree d = m2expr_Build3TruthAndIf (location, i_lt_zero, j_gt_zero,
1952 : : divCeilOverflowNegPos (location, i, j, lowest, min, max));
1953 : 148 : return m2expr_Build4TruthOrIf (location, a, b, c, d);
1954 : : }
1955 : :
1956 : :
1957 : : /* checkWholeDivCeilOverflow check to see whether i DIV_CEIL j will overflow
1958 : : an integer. A handbuilt expression of trees implementing:
1959 : :
1960 : : RETURN ((j = 0) OR (* division by zero. *)
1961 : : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
1962 : : therefore error. *)
1963 : : ((i # 0) AND (* first operand is legally zero,
1964 : : result is also legally zero. *)
1965 : : divCeilOverflowCases (i, j)))
1966 : :
1967 : : using the following subexpressions:
1968 : :
1969 : : j_eq_zero -> (j == 0)
1970 : : max_lt_zero -> (max < 0)
1971 : : i_ne_zero -> (i # 0). */
1972 : :
1973 : : static tree
1974 : 148 : checkWholeDivCeilOverflow (location_t location, tree i, tree j, tree lowest,
1975 : : tree min, tree max)
1976 : : {
1977 : 148 : tree j_eq_zero = m2expr_BuildEqualToZero (location, j, lowest, min, max);
1978 : 148 : tree max_lt_zero = m2expr_BuildLessThanZero (location, max, lowest, min, max);
1979 : 148 : tree i_ne_zero = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
1980 : 148 : tree j_lt_zero;
1981 : 148 : tree rhs = m2expr_BuildTruthAndIf (location,
1982 : : i_ne_zero,
1983 : : divCeilOverflowCases (location,
1984 : : i, j, lowest, min, max));
1985 : :
1986 : 148 : if (M2Options_GetISO ())
1987 : 148 : j_lt_zero = m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location, j, lowest, min, max));
1988 : : else
1989 : 0 : j_lt_zero = m2expr_GetIntegerZero (location);
1990 : 148 : j_eq_zero = m2expr_FoldAndStrip (j_eq_zero);
1991 : 148 : max_lt_zero = m2expr_FoldAndStrip (max_lt_zero);
1992 : 148 : i_ne_zero = m2expr_FoldAndStrip (i_ne_zero);
1993 : 148 : rhs = m2expr_FoldAndStrip (rhs);
1994 : :
1995 : 148 : tree condition = m2expr_Build4TruthOrIf (location, j_eq_zero, max_lt_zero, rhs, j_lt_zero);
1996 : 148 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1997 : : get_current_function_name (),
1998 : : "whole value ceil division will cause a range overflow");
1999 : 148 : return t;
2000 : : }
2001 : :
2002 : :
2003 : : /* checkWholeModTruncOverflow, the GCC tree.def defines TRUNC_MOD_EXPR to return
2004 : : the remainder which has the same sign as the dividend. In ISO Modula-2 the
2005 : : divisor must never be negative (or zero). The pseudo code for implementing these
2006 : : checks is given below:
2007 : :
2008 : : IF j = 0
2009 : : THEN
2010 : : RETURN TRUE (* division by zero. *)
2011 : : ELSIF j < 0
2012 : : THEN
2013 : : RETURN TRUE (* modulus and division by negative (rhs) not allowed in ISO Modula-2. *)
2014 : : ELSIF i = 0
2015 : : THEN
2016 : : RETURN FALSE (* must be legal as result is same as operand. *)
2017 : : ELSIF i > 0
2018 : : THEN
2019 : : (* test for: i MOD j < minT *)
2020 : : IF j > i
2021 : : THEN
2022 : : RETURN FALSE
2023 : : END ;
2024 : : RETURN i - ((i DIV j) * j) < minT
2025 : : ELSIF i < 0
2026 : : THEN
2027 : : (* the result will always be positive and less than i, given that j is less than zero
2028 : : we know that minT must be < 0 as well and therefore the result of i MOD j will
2029 : : never underflow. *)
2030 : : RETURN FALSE
2031 : : END ;
2032 : : RETURN FALSE
2033 : :
2034 : : which can be converted into a large expression:
2035 : :
2036 : : RETURN (j = 0) OR ((j < 0) AND ISO) OR
2037 : : ((i # 0) AND (j <= i) AND (i - ((i DIVtrunc j) * j) < minT)
2038 : :
2039 : : and into GCC trees:
2040 : :
2041 : : c1 -> (j = 0)
2042 : : c2 -> (j < 0) (* only called from ISO or PIM4 or -fpositive-mod-floor *)
2043 : : c3 -> (i # 0)
2044 : : c4 -> (j <= i)
2045 : : c6 -> (i DIVtrunc j)
2046 : : c7 -> (i - (c6 * j))
2047 : : c5 -> c7 < minT
2048 : :
2049 : : t -> (c1 OR c2 OR
2050 : : (c3 AND c4 AND c5)). */
2051 : :
2052 : : static tree
2053 : 4 : checkWholeModTruncOverflow (location_t location, tree i, tree j, tree lowest,
2054 : : tree min, tree max)
2055 : : {
2056 : 4 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2057 : 4 : tree c2 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
2058 : 4 : tree c3 = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
2059 : 4 : tree c4 = m2expr_BuildLessThanOrEqual (location, j, i);
2060 : 4 : tree c6 = m2expr_BuildDivTrunc (location, i, j, false);
2061 : 4 : tree c7 = m2expr_BuildSub (location, i, m2expr_BuildMult (location, c6, j, false), false);
2062 : 4 : tree c5 = m2expr_BuildLessThan (location, c7, min);
2063 : 4 : tree c8 = m2expr_Build3TruthAndIf (location, c3, c4, c5);
2064 : 4 : tree condition = m2expr_Build3TruthOrIf (location, c1, c2, c8);
2065 : 4 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2066 : : get_current_function_name (),
2067 : : "whole value trunc modulus will cause a range overflow");
2068 : 4 : return t;
2069 : : }
2070 : :
2071 : :
2072 : : /* checkWholeModCeilOverflow, the GCC tree.def defines CEIL_MOD_EXPR to return
2073 : : the remainder which has the same opposite of the divisor. In gm2 this is
2074 : : only called when the divisor is negative. The pseudo code for implementing
2075 : : these checks is given below:
2076 : :
2077 : : IF j = 0
2078 : : THEN
2079 : : RETURN TRUE (* division by zero. *)
2080 : : END ;
2081 : : t := i - j * divceil (i, j) ;
2082 : : printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
2083 : : t, i, j, i, j, divceil (i, j));
2084 : : RETURN NOT ((t >= minT) AND (t <= maxT))
2085 : :
2086 : : which can be converted into the expression:
2087 : :
2088 : : t := i - j * divceil (i, j) ;
2089 : : RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
2090 : :
2091 : : and into GCC trees:
2092 : :
2093 : : c1 -> (j = 0)
2094 : : c2 -> (i - j)
2095 : : c3 -> (i DIVceil j)
2096 : : t -> (c2 * c3)
2097 : : c4 -> (t >= minT)
2098 : : c5 -> (t <= maxT)
2099 : : c6 -> (c4 AND c5)
2100 : : c7 -> (NOT c6)
2101 : : c8 -> (c1 OR c7)
2102 : : return c8. */
2103 : :
2104 : : static tree
2105 : 64 : checkWholeModCeilOverflow (location_t location,
2106 : : tree i, tree j, tree lowest,
2107 : : tree min, tree max)
2108 : : {
2109 : 64 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2110 : 64 : tree c2 = m2expr_BuildSub (location, i, j, false);
2111 : 64 : tree c3 = m2expr_BuildDivCeil (location, i, j, false);
2112 : 64 : tree t = m2expr_BuildMult (location, c2, c3, false);
2113 : 64 : tree c4 = m2expr_BuildGreaterThanOrEqual (location, t, min);
2114 : 64 : tree c5 = m2expr_BuildLessThanOrEqual (location, t, max);
2115 : 64 : tree c6 = m2expr_BuildTruthAndIf (location, c4, c5);
2116 : 64 : tree c7 = m2expr_BuildTruthNot (location, c6);
2117 : 64 : tree condition = m2expr_BuildTruthOrIf (location, c1, c7);
2118 : 64 : tree s = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2119 : : get_current_function_name (),
2120 : : "whole value ceil modulus will cause a range overflow");
2121 : 64 : return s;
2122 : : }
2123 : :
2124 : :
2125 : : /* checkWholeModFloorOverflow, the GCC tree.def defines FLOOR_MOD_EXPR to return
2126 : : the remainder which has the same sign as the divisor. In gm2 this is
2127 : : only called when the divisor is positive. The pseudo code for implementing
2128 : : these checks is given below:
2129 : :
2130 : : IF j = 0
2131 : : THEN
2132 : : RETURN TRUE (* division by zero. *)
2133 : : END ;
2134 : : t := i - j * divfloor (i, j) ;
2135 : : printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
2136 : : t, i, j, i, j, divfloor (i, j));
2137 : : RETURN NOT ((t >= minT) AND (t <= maxT))
2138 : :
2139 : : which can be converted into the expression:
2140 : :
2141 : : t := i - j * divfloor (i, j) ;
2142 : : RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
2143 : :
2144 : : and into GCC trees:
2145 : :
2146 : : c1 -> (j = 0)
2147 : : c2 -> (i - j)
2148 : : c3 -> (i DIVfloor j)
2149 : : t -> (c2 * c3)
2150 : : c4 -> (t >= minT)
2151 : : c5 -> (t <= maxT)
2152 : : c6 -> (c4 AND c5)
2153 : : c7 -> (NOT c6)
2154 : : c8 -> (c1 OR c7)
2155 : : return c8. */
2156 : :
2157 : : static tree
2158 : 64 : checkWholeModFloorOverflow (location_t location,
2159 : : tree i, tree j, tree lowest,
2160 : : tree min, tree max)
2161 : : {
2162 : 64 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2163 : 64 : tree c2 = m2expr_BuildSub (location, i, j, false);
2164 : 64 : tree c3 = m2expr_BuildDivFloor (location, i, j, false);
2165 : 64 : tree t = m2expr_BuildMult (location, c2, c3, false);
2166 : 64 : tree c4 = m2expr_BuildGreaterThanOrEqual (location, t, min);
2167 : 64 : tree c5 = m2expr_BuildLessThanOrEqual (location, t, max);
2168 : 64 : tree c6 = m2expr_BuildTruthAndIf (location, c4, c5);
2169 : 64 : tree c7 = m2expr_BuildTruthNot (location, c6);
2170 : 64 : tree condition = m2expr_BuildTruthOrIf (location, c1, c7);
2171 : 64 : tree s = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2172 : : get_current_function_name (),
2173 : : "whole value floor modulus will cause a range overflow");
2174 : 64 : return s;
2175 : : }
2176 : :
2177 : :
2178 : : #if 0
2179 : : /* The following is a Modula-2 implementation of the C tree node code
2180 : : this code has been hand translated into GCC trees. */
2181 : :
2182 : : (*
2183 : : divFloorOverflow2 - returns true if an overflow will occur
2184 : : if i divfloor j is performed.
2185 : : *)
2186 : :
2187 : : PROCEDURE divFloorOverflow (i, j: INTEGER) : BOOLEAN ;
2188 : : BEGIN
2189 : : RETURN ((j = 0) OR (* division by zero. *)
2190 : : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
2191 : : therefore error. *)
2192 : : (* --fixme-- remember here to also check
2193 : : if ISO M2 dialect and j < 0
2194 : : which will also generate an error. *)
2195 : : ((i # 0) AND (* first operand is legally zero,
2196 : : result is also legally zero. *)
2197 : : divFloorOverflowCases (i, j)))
2198 : : END divFloorOverflow ;
2199 : :
2200 : :
2201 : : (*
2202 : : divFloorOverflowCases - precondition: i, j are in range values.
2203 : : postcondition: true is returned if i divfloor will
2204 : : result in an overflow/underflow.
2205 : : *)
2206 : :
2207 : : PROCEDURE divFloorOverflowCases (i, j: INTEGER) : BOOLEAN ;
2208 : : BEGIN
2209 : : RETURN (((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j)) OR
2210 : : ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j)) OR
2211 : : ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j)) OR
2212 : : ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j)))
2213 : : END divFloorOverflowCases ;
2214 : :
2215 : :
2216 : : (*
2217 : : divFloorOverflowPosPos - precondition: lhs, rhs are legal and are both >= 0.
2218 : : postcondition: true is returned if lhs divfloor rhs will
2219 : : result in an overflow/underflow.
2220 : : *)
2221 : :
2222 : : PROCEDURE divFloorOverflowPosPos (lhs, rhs: INTEGER) : BOOLEAN ;
2223 : : BEGIN
2224 : : RETURN multMinOverflow (rhs) OR (lhs < rhs * min)
2225 : : END divFloorOverflowPosPos ;
2226 : :
2227 : :
2228 : : (*
2229 : : divFloorOverflowNegNeg - precondition: i, j are in range values and both < 0.
2230 : : postcondition: true is returned if i divfloor will
2231 : : result in an overflow/underflow.
2232 : : *)
2233 : :
2234 : : PROCEDURE divFloorOverflowNegNeg (i, j: INTEGER) : BOOLEAN ;
2235 : : BEGIN
2236 : : RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
2237 : : (* check for underflow. *)
2238 : : (i >= j * minT) OR
2239 : : (* check for overflow. *)
2240 : : (ABS (i) DIV maxT > ABS (j)))
2241 : : END divFloorOverflowNegNeg ;
2242 : :
2243 : :
2244 : : (*
2245 : : divFloorOverflowNegPos - precondition: i, j are in range values. i < 0, j >= 0.
2246 : : postcondition: true is returned if i divfloor will
2247 : : result in an overflow/underflow.
2248 : : *)
2249 : :
2250 : : PROCEDURE divFloorOverflowNegPos (i, j: INTEGER) : BOOLEAN ;
2251 : : BEGIN
2252 : : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
2253 : : We know the result will be negative and therefore we only need to test
2254 : : against minT. *)
2255 : : RETURN i < j * minT
2256 : : END divFloorOverflowNegPos ;
2257 : :
2258 : :
2259 : : (*
2260 : : divFloorOverflowPosNeg - precondition: i, j are in range values. i >= 0, j < 0.
2261 : : postcondition: true is returned if i divfloor will
2262 : : result in an overflow/underflow.
2263 : : *)
2264 : :
2265 : : PROCEDURE divFloorOverflowPosNeg (i, j: INTEGER) : BOOLEAN ;
2266 : : BEGIN
2267 : : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
2268 : : We know the result will be negative and therefore we only need to test
2269 : : against minT. *)
2270 : : RETURN i >= j * minT - j (* is safer than i > j * minT -1 *)
2271 : : END divFloorOverflowPosNeg ;
2272 : : #endif
2273 : :
2274 : :
2275 : : /* divFloorOverflowPosPos, precondition: i, j are legal and are both >= 0.
2276 : : Postcondition: true is returned if i divfloor will result in an overflow/underflow.
2277 : :
2278 : : A handbuilt expression of trees implementing:
2279 : :
2280 : : RETURN i < j * min
2281 : :
2282 : : j_mult_min -> (j * min)
2283 : : RETURN i < j_mult_min. */
2284 : :
2285 : : static tree
2286 : 148 : divFloorOverflowPosPos (location_t location, tree i, tree j, tree min)
2287 : : {
2288 : 148 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2289 : 148 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
2290 : 148 : return i_lt_j_mult_min;
2291 : : }
2292 : :
2293 : :
2294 : : /* divFloorOverflowNegNeg precondition: i, j are in range values and both < 0.
2295 : : Postcondition: true is returned if i divfloor j will result in an
2296 : : overflow/underflow.
2297 : :
2298 : : A handbuilt expression of trees implementing:
2299 : :
2300 : : RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
2301 : : (* check for underflow. *)
2302 : : (i >= j * min) OR
2303 : : (* check for overflow. *)
2304 : : (ABS (i) DIV max > ABS (j)))
2305 : :
2306 : : max_lte_0 -> (max <= 0)
2307 : : abs_i -> (ABS (i))
2308 : : abs_j -> (ABS (j))
2309 : : j_mult_min -> (j * min)
2310 : : i_ge_j_mult_min -> (i >= j_mult_min)
2311 : : abs_i_div_max -> (abs_i divfloor max)
2312 : : abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
2313 : :
2314 : : return max_lte_0 OR
2315 : : i_ge_j_mult_min OR
2316 : : abs_i_div_max_gt_abs_j. */
2317 : :
2318 : : static tree
2319 : 148 : divFloorOverflowNegNeg (location_t location, tree i, tree j, tree lowest,
2320 : : tree min, tree max)
2321 : : {
2322 : 148 : tree max_lte_0 = m2expr_BuildLessThanOrEqualZero (location, max, lowest, min, max);
2323 : 148 : tree abs_i = m2expr_BuildAbs (location, i);
2324 : 148 : tree abs_j = m2expr_BuildAbs (location, j);
2325 : 148 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2326 : 148 : tree i_ge_j_mult_min = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min);
2327 : 148 : tree abs_i_div_max = m2expr_BuildDivFloor (location, abs_i, max, false);
2328 : 148 : tree abs_i_div_max_gt_abs_j = m2expr_BuildGreaterThan (location, abs_i_div_max, abs_j);
2329 : :
2330 : 148 : return m2expr_Build3TruthOrIf (location, max_lte_0, i_ge_j_mult_min, abs_i_div_max_gt_abs_j);
2331 : : }
2332 : :
2333 : :
2334 : : /* divFloorOverflowPosNeg precondition: i, j are in range values and i >=0, j < 0.
2335 : : Postcondition: true is returned if i divfloor j will result in an
2336 : : overflow/underflow.
2337 : :
2338 : : A handbuilt expression of trees implementing:
2339 : :
2340 : : RETURN i >= j * min - j (* is safer than i > j * min -1 *)
2341 : :
2342 : : j_mult_min -> (j * min)
2343 : : j_mult_min_sub_j -> (j_mult_min - j)
2344 : : i_ge_j_mult_min_sub_j -> (i >= j_mult_min_sub_j)
2345 : :
2346 : : return i_ge_j_mult_min_sub_j. */
2347 : :
2348 : : static tree
2349 : 148 : divFloorOverflowPosNeg (location_t location, tree i, tree j, tree min)
2350 : : {
2351 : 148 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2352 : 148 : tree j_mult_min_sub_j = m2expr_BuildSub (location, j_mult_min, j, false);
2353 : 148 : tree i_ge_j_mult_min_sub_j = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min_sub_j);
2354 : 148 : return i_ge_j_mult_min_sub_j;
2355 : : }
2356 : :
2357 : :
2358 : : /* divFloorOverflowNegPos precondition: i, j are in range values and i < 0, j > 0.
2359 : : Postcondition: true is returned if i divfloor j will result in an
2360 : : overflow/underflow.
2361 : :
2362 : : A handbuilt expression of trees implementing:
2363 : :
2364 : : RETURN i < j * min
2365 : :
2366 : : j_mult_min -> (j * min)
2367 : : RETURN i < j_mult_min. */
2368 : :
2369 : : static tree
2370 : 148 : divFloorOverflowNegPos (location_t location, tree i, tree j, tree min)
2371 : : {
2372 : 148 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2373 : 148 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
2374 : 148 : return i_lt_j_mult_min;
2375 : : }
2376 : :
2377 : :
2378 : : /* divFloorOverflowCases, precondition: i, j are in range values.
2379 : : Postcondition: true is returned if i divfloor will result in an
2380 : : overflow/underflow.
2381 : :
2382 : : A handbuilt expression of trees implementing:
2383 : :
2384 : : RETURN (((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j)) OR
2385 : : ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j)) OR
2386 : : ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j)) OR
2387 : : ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j)))
2388 : :
2389 : : a -> ((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j))
2390 : : b -> ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j))
2391 : : c -> ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j))
2392 : : d -> ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j))
2393 : :
2394 : : RETURN a AND b AND c AND d. */
2395 : :
2396 : : static tree
2397 : 148 : divFloorOverflowCases (location_t location, tree i, tree j, tree lowest,
2398 : : tree min, tree max)
2399 : : {
2400 : 148 : tree i_gt_zero = m2expr_BuildGreaterThanZero (location, i, lowest, min, max);
2401 : 148 : tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
2402 : 148 : tree i_lt_zero = m2expr_BuildLessThanZero (location, i, lowest, min, max);
2403 : 148 : tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
2404 : 148 : tree a = m2expr_Build3TruthAndIf (location, i_gt_zero, j_gt_zero,
2405 : : divFloorOverflowPosPos (location, i, j, min));
2406 : 148 : tree b = m2expr_Build3TruthAndIf (location, i_lt_zero, j_lt_zero,
2407 : : divFloorOverflowNegNeg (location, i, j, lowest, min, max));
2408 : 148 : tree c = m2expr_Build3TruthAndIf (location, i_gt_zero, j_lt_zero,
2409 : : divFloorOverflowPosNeg (location, i, j, min));
2410 : 148 : tree d = m2expr_Build3TruthAndIf (location, i_lt_zero, j_gt_zero,
2411 : : divFloorOverflowNegPos (location, i, j, min));
2412 : 148 : return m2expr_Build4TruthOrIf (location, a, b, c, d);
2413 : : }
2414 : :
2415 : :
2416 : : /* checkWholeDivFloorOverflow check to see whether i DIV_FLOOR j will overflow
2417 : : an integer. A handbuilt expression of trees implementing:
2418 : :
2419 : : RETURN ((j = 0) OR (* division by zero. *)
2420 : : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
2421 : : therefore error. *)
2422 : : (* we also check
2423 : : if ISO M2 dialect and j < 0
2424 : : which will also generate an error. *)
2425 : : ((i # 0) AND (* first operand is legally zero,
2426 : : result is also legally zero. *)
2427 : : divFloorOverflowCases (i, j)))
2428 : :
2429 : : using the following subexpressions:
2430 : :
2431 : : j_eq_zero -> (j == 0)
2432 : : max_lt_zero -> (max < 0)
2433 : : i_ne_zero -> (i # 0). */
2434 : :
2435 : : static tree
2436 : 148 : checkWholeDivFloorOverflow (location_t location, tree i, tree j, tree lowest,
2437 : : tree min, tree max)
2438 : : {
2439 : 148 : tree j_eq_zero = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2440 : 148 : tree max_lt_zero = m2expr_BuildLessThanZero (location, max, lowest, min, max);
2441 : 148 : tree i_ne_zero = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
2442 : 148 : tree j_lt_zero;
2443 : 148 : tree rhs = m2expr_BuildTruthAndIf (location,
2444 : : i_ne_zero,
2445 : : divFloorOverflowCases (location,
2446 : : i, j, lowest, min, max));
2447 : :
2448 : 148 : if (M2Options_GetISO ())
2449 : : /* ISO Modula-2 raises an exception if the right hand operand is < 0. */
2450 : 148 : j_lt_zero = m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location, j, lowest, min, max));
2451 : : else
2452 : 0 : j_lt_zero = m2expr_GetIntegerZero (location);
2453 : 148 : j_eq_zero = m2expr_FoldAndStrip (j_eq_zero);
2454 : 148 : max_lt_zero = m2expr_FoldAndStrip (max_lt_zero);
2455 : 148 : i_ne_zero = m2expr_FoldAndStrip (i_ne_zero);
2456 : 148 : rhs = m2expr_FoldAndStrip (rhs);
2457 : :
2458 : 148 : tree condition = m2expr_Build4TruthOrIf (location, j_eq_zero, max_lt_zero, rhs, j_lt_zero);
2459 : 148 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2460 : : get_current_function_name (),
2461 : : "whole value floor division will cause a range overflow");
2462 : 148 : return t;
2463 : : }
2464 : :
2465 : : /* checkWholeOverflow check to see if the binary operators will overflow
2466 : : ordinal types. */
2467 : :
2468 : : static tree
2469 : 43439 : m2expr_checkWholeOverflow (location_t location, enum tree_code code, tree op1,
2470 : : tree op2, tree lowest, tree min, tree max)
2471 : : {
2472 : 43439 : if (M2Options_GetWholeValueCheck () && (min != NULL))
2473 : : {
2474 : 3592 : lowest = m2tree_skip_type_decl (lowest);
2475 : 3592 : op1 = fold_convert_loc (location, lowest, op1);
2476 : 3592 : op2 = fold_convert_loc (location, lowest, op2);
2477 : :
2478 : 3592 : switch (code)
2479 : : {
2480 : 1504 : case PLUS_EXPR:
2481 : 1504 : return checkWholeAddOverflow (location, op1, op2, lowest, min, max);
2482 : 956 : case MINUS_EXPR:
2483 : 956 : return checkWholeSubOverflow (location, op1, op2, lowest, min, max);
2484 : 672 : case MULT_EXPR:
2485 : 672 : return checkWholeMultOverflow (location, op1, op2, lowest, min, max);
2486 : 32 : case TRUNC_DIV_EXPR:
2487 : 32 : return checkWholeDivTruncOverflow (location, op1, op2, lowest, min, max);
2488 : 148 : case CEIL_DIV_EXPR:
2489 : 148 : return checkWholeDivCeilOverflow (location, op1, op2, lowest, min, max);
2490 : 148 : case FLOOR_DIV_EXPR:
2491 : 148 : return checkWholeDivFloorOverflow (location, op1, op2, lowest, min, max);
2492 : 4 : case TRUNC_MOD_EXPR:
2493 : 4 : return checkWholeModTruncOverflow (location, op1, op2, lowest, min, max);
2494 : 64 : case CEIL_MOD_EXPR:
2495 : 64 : return checkWholeModCeilOverflow (location, op1, op2, lowest, min, max);
2496 : 64 : case FLOOR_MOD_EXPR:
2497 : 64 : return checkWholeModFloorOverflow (location, op1, op2, lowest, min, max);
2498 : : default:
2499 : : return NULL;
2500 : : }
2501 : : }
2502 : : return NULL;
2503 : : }
2504 : :
2505 : : /* checkRealOverflow if we have enabled real value checking then
2506 : : generate an overflow check appropriate to the tree code being used. */
2507 : :
2508 : : static void
2509 : 1550 : m2expr_checkRealOverflow (location_t location, enum tree_code code,
2510 : : tree result)
2511 : : {
2512 : 1550 : if (M2Options_GetFloatValueCheck ())
2513 : : {
2514 : 72 : tree condition = m2expr_BuildEqualTo (
2515 : : location, m2builtins_BuiltInIsfinite (location, result),
2516 : : m2expr_GetIntegerZero (location));
2517 : 72 : switch (code)
2518 : : {
2519 : 0 : case PLUS_EXPR:
2520 : 0 : m2type_AddStatement (location,
2521 : : M2Range_BuildIfCallRealHandlerLoc (
2522 : : location, condition,
2523 : : get_current_function_name (),
2524 : : "floating point + has caused an overflow"));
2525 : 0 : break;
2526 : 0 : case MINUS_EXPR:
2527 : 0 : m2type_AddStatement (location,
2528 : : M2Range_BuildIfCallRealHandlerLoc (
2529 : : location, condition,
2530 : : get_current_function_name (),
2531 : : "floating point - has caused an overflow"));
2532 : 0 : break;
2533 : 12 : case RDIV_EXPR:
2534 : 12 : case FLOOR_DIV_EXPR:
2535 : 12 : case CEIL_DIV_EXPR:
2536 : 12 : case TRUNC_DIV_EXPR:
2537 : 12 : m2type_AddStatement (location,
2538 : : M2Range_BuildIfCallRealHandlerLoc (
2539 : : location, condition,
2540 : : get_current_function_name (),
2541 : : "floating point / has caused an overflow"));
2542 : 12 : break;
2543 : 12 : case MULT_EXPR:
2544 : 12 : m2type_AddStatement (location,
2545 : : M2Range_BuildIfCallRealHandlerLoc (
2546 : : location, condition,
2547 : : get_current_function_name (),
2548 : : "floating point * has caused an overflow"));
2549 : 12 : break;
2550 : 0 : case NEGATE_EXPR:
2551 : 0 : m2type_AddStatement (
2552 : : location, M2Range_BuildIfCallRealHandlerLoc (
2553 : : location, condition,
2554 : : get_current_function_name (),
2555 : : "floating point unary - has caused an overflow"));
2556 : : default:
2557 : : break;
2558 : : }
2559 : : }
2560 : 1550 : }
2561 : :
2562 : : /* build_binary_op, a wrapper for the lower level build_binary_op
2563 : : above. */
2564 : :
2565 : : tree
2566 : 2089375 : m2expr_build_binary_op_check (location_t location, enum tree_code code,
2567 : : tree op1, tree op2, bool needconvert, tree lowest,
2568 : : tree min, tree max)
2569 : : {
2570 : 2089375 : tree type1, type2, result;
2571 : 2089375 : tree check = NULL;
2572 : :
2573 : 2089375 : op1 = m2expr_FoldAndStrip (op1);
2574 : 2089375 : op2 = m2expr_FoldAndStrip (op2);
2575 : :
2576 : 2089375 : type1 = m2tree_skip_type_decl (TREE_TYPE (op1));
2577 : 2089375 : type2 = m2tree_skip_type_decl (TREE_TYPE (op2));
2578 : :
2579 : 2089375 : m2assert_AssertLocation (location);
2580 : :
2581 : 2089375 : if (code == PLUS_EXPR)
2582 : : {
2583 : 187981 : if (POINTER_TYPE_P (type1))
2584 : : {
2585 : 2675 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2586 : 2675 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
2587 : 2675 : op1, op2);
2588 : : }
2589 : 185306 : else if (POINTER_TYPE_P (type2))
2590 : : {
2591 : 0 : op1 = fold_convert_loc (location, sizetype, unshare_expr (op1));
2592 : 0 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op2),
2593 : 0 : op2, op1);
2594 : : }
2595 : : }
2596 : 2086700 : if (code == MINUS_EXPR)
2597 : : {
2598 : 541625 : if (POINTER_TYPE_P (type1))
2599 : : {
2600 : 12 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2601 : 12 : op2 = fold_build1_loc (location, NEGATE_EXPR, sizetype, op2);
2602 : 12 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
2603 : 12 : op1, op2);
2604 : : }
2605 : 541613 : else if (POINTER_TYPE_P (type2))
2606 : : {
2607 : 0 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2608 : 0 : op2 = fold_build1_loc (location, NEGATE_EXPR, sizetype, op2);
2609 : 0 : op1 = fold_convert_loc (location, sizetype, unshare_expr (op1));
2610 : 0 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op2),
2611 : 0 : op2, op1);
2612 : : }
2613 : : }
2614 : :
2615 : 2086688 : if ((code != LSHIFT_EXPR) && (code != RSHIFT_EXPR) && (code != LROTATE_EXPR)
2616 : : && (code == RROTATE_EXPR))
2617 : 74 : if (type1 != type2)
2618 : 0 : error_at (location, "not expecting different types to binary operator");
2619 : :
2620 : 2086688 : if ((TREE_CODE (type1) != REAL_TYPE) && (min != NULL))
2621 : 43439 : check = m2expr_checkWholeOverflow (location, code, op1, op2, lowest, min, max);
2622 : :
2623 : 2086688 : result = build_binary_op (location, code, op1, op2, needconvert);
2624 : 2086688 : if (check != NULL)
2625 : 3592 : result = build2 (COMPOUND_EXPR, TREE_TYPE (result), check, result);
2626 : :
2627 : 2086688 : if (SCALAR_FLOAT_TYPE_P (type1))
2628 : 1486 : m2expr_checkRealOverflow (location, code, result);
2629 : : return result;
2630 : : }
2631 : :
2632 : : /* build_binary_op, a wrapper for the lower level build_binary_op
2633 : : above. */
2634 : :
2635 : : tree
2636 : 2041989 : m2expr_build_binary_op (location_t location, enum tree_code code, tree op1,
2637 : : tree op2, int convert)
2638 : : {
2639 : 2041989 : return m2expr_build_binary_op_check (location, code, op1, op2, convert, NULL,
2640 : 2041989 : NULL, NULL);
2641 : : }
2642 : :
2643 : : /* BuildAddAddress return an expression op1+op2 where op1 is a
2644 : : pointer type and op2 is not a pointer type. */
2645 : :
2646 : : tree
2647 : 776 : m2expr_BuildAddAddress (location_t location, tree op1, tree op2)
2648 : : {
2649 : 776 : tree type1, type2;
2650 : :
2651 : 776 : op1 = m2expr_FoldAndStrip (op1);
2652 : 776 : op2 = m2expr_FoldAndStrip (op2);
2653 : :
2654 : 776 : type1 = m2tree_skip_type_decl (TREE_TYPE (op1));
2655 : 776 : type2 = m2tree_skip_type_decl (TREE_TYPE (op2));
2656 : :
2657 : 776 : m2assert_AssertLocation (location);
2658 : 776 : ASSERT_CONDITION (POINTER_TYPE_P (type1));
2659 : 776 : ASSERT_CONDITION (!POINTER_TYPE_P (type2));
2660 : :
2661 : 776 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2662 : 776 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
2663 : : m2expr_FoldAndStrip (op1),
2664 : 776 : m2expr_FoldAndStrip (op2));
2665 : : }
2666 : :
2667 : : /* BuildNegateCheck builds a negate tree. */
2668 : :
2669 : : tree
2670 : 812 : m2expr_BuildNegateCheck (location_t location, tree arg, tree lowest, tree min,
2671 : : tree max)
2672 : : {
2673 : 812 : tree t;
2674 : :
2675 : 812 : m2assert_AssertLocation (location);
2676 : :
2677 : 812 : arg = m2expr_FoldAndStrip (arg);
2678 : 812 : arg = CheckAddressToCardinal (location, arg);
2679 : :
2680 : 812 : t = m2expr_build_unary_op_check (location, NEGATE_EXPR, arg, lowest, min,
2681 : : max);
2682 : 812 : return m2expr_FoldAndStrip (t);
2683 : : }
2684 : :
2685 : : /* BuildNegate build a negate expression and returns the tree. */
2686 : :
2687 : : tree
2688 : 23648 : m2expr_BuildNegate (location_t location, tree op1, bool needconvert)
2689 : : {
2690 : 23648 : m2assert_AssertLocation (location);
2691 : 23648 : op1 = m2expr_FoldAndStrip (op1);
2692 : 23648 : op1 = CheckAddressToCardinal (location, op1);
2693 : :
2694 : 23648 : return m2expr_build_unary_op (location, NEGATE_EXPR, op1, needconvert);
2695 : : }
2696 : :
2697 : : /* BuildSetNegate build a set negate expression and returns the tree. */
2698 : :
2699 : : tree
2700 : 583 : m2expr_BuildSetNegate (location_t location, tree op1, bool needconvert)
2701 : : {
2702 : 583 : m2assert_AssertLocation (location);
2703 : :
2704 : 583 : return m2expr_build_binary_op (
2705 : : location, BIT_XOR_EXPR,
2706 : : m2convert_BuildConvert (location, m2type_GetWordType (),
2707 : : m2expr_FoldAndStrip (op1), false),
2708 : 583 : set_full_complement, needconvert);
2709 : : }
2710 : :
2711 : : /* BuildMult build a multiplication tree. */
2712 : :
2713 : : tree
2714 : 20516 : m2expr_BuildMult (location_t location, tree op1, tree op2, bool needconvert)
2715 : : {
2716 : 20516 : op1 = m2expr_FoldAndStrip (op1);
2717 : 20516 : op2 = m2expr_FoldAndStrip (op2);
2718 : :
2719 : 20516 : m2assert_AssertLocation (location);
2720 : :
2721 : 20516 : op1 = CheckAddressToCardinal (location, op1);
2722 : 20516 : op2 = CheckAddressToCardinal (location, op2);
2723 : :
2724 : 20516 : return m2expr_build_binary_op (location, MULT_EXPR, op1, op2, needconvert);
2725 : : }
2726 : :
2727 : : /* BuildMultCheck builds a multiplication tree. */
2728 : :
2729 : : tree
2730 : 10143 : m2expr_BuildMultCheck (location_t location, tree op1, tree op2, tree lowest,
2731 : : tree min, tree max)
2732 : : {
2733 : 10143 : tree t;
2734 : :
2735 : 10143 : m2assert_AssertLocation (location);
2736 : :
2737 : 10143 : op1 = m2expr_FoldAndStrip (op1);
2738 : 10143 : op2 = m2expr_FoldAndStrip (op2);
2739 : :
2740 : 10143 : op1 = CheckAddressToCardinal (location, op1);
2741 : 10143 : op2 = CheckAddressToCardinal (location, op2);
2742 : :
2743 : 10143 : t = m2expr_build_binary_op_check (location, MULT_EXPR, op1, op2, false,
2744 : : lowest, min, max);
2745 : 10143 : return m2expr_FoldAndStrip (t);
2746 : : }
2747 : :
2748 : : /* testLimits return the number of bits required to represent:
2749 : : min..max if it matches the, type. Otherwise NULL_TREE is returned. */
2750 : :
2751 : : static tree
2752 : 684 : testLimits (location_t location, tree type, tree min, tree max)
2753 : : {
2754 : 684 : m2assert_AssertLocation (location);
2755 : :
2756 : 684 : if ((m2expr_CompareTrees (TYPE_MAX_VALUE (type), max) == 0)
2757 : 684 : && (m2expr_CompareTrees (TYPE_MIN_VALUE (type), min) == 0))
2758 : 6 : return m2expr_BuildMult (location, m2expr_GetSizeOf (location, type),
2759 : : m2decl_BuildIntegerConstant (BITS_PER_UNIT),
2760 : 6 : false);
2761 : : return NULL_TREE;
2762 : : }
2763 : :
2764 : : /* noBitsRequired return the number of bits required to contain, values. */
2765 : :
2766 : : static tree
2767 : 336 : noBitsRequired (tree values)
2768 : : {
2769 : 336 : int bits = tree_floor_log2 (values);
2770 : :
2771 : 336 : return m2decl_BuildIntegerConstant (bits + 1);
2772 : : }
2773 : :
2774 : : /* getMax return the result of max (a, b). */
2775 : :
2776 : : static tree
2777 : 336 : getMax (tree a, tree b)
2778 : : {
2779 : 336 : if (m2expr_CompareTrees (a, b) > 0)
2780 : : return a;
2781 : : else
2782 : 336 : return b;
2783 : : }
2784 : :
2785 : : /* calcNbits return the smallest number of bits required to
2786 : : represent: min..max. */
2787 : :
2788 : : tree
2789 : 342 : m2expr_calcNbits (location_t location, tree min, tree max)
2790 : : {
2791 : 342 : int negative = false;
2792 : 342 : tree t = testLimits (location, m2type_GetIntegerType (), min, max);
2793 : :
2794 : 342 : m2assert_AssertLocation (location);
2795 : :
2796 : 342 : if (t == NULL)
2797 : 342 : t = testLimits (location, m2type_GetCardinalType (), min, max);
2798 : :
2799 : 342 : if (t == NULL)
2800 : : {
2801 : 336 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) < 0)
2802 : : {
2803 : 0 : min = m2expr_BuildAdd (location, min,
2804 : : m2expr_GetIntegerOne (location), false);
2805 : 0 : min = fold (m2expr_BuildNegate (location, min, false));
2806 : 0 : negative = true;
2807 : : }
2808 : 336 : if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
2809 : : {
2810 : 12 : max = fold (m2expr_BuildNegate (location, max, false));
2811 : 12 : negative = true;
2812 : : }
2813 : 672 : t = noBitsRequired (getMax (min, max));
2814 : 336 : if (negative)
2815 : 12 : t = m2expr_BuildAdd (location, t, m2expr_GetIntegerOne (location),
2816 : : false);
2817 : : }
2818 : 342 : return t;
2819 : : }
2820 : :
2821 : : /* BuildTBitSize return the minimum number of bits to represent type.
2822 : : This function is called internally by cc1gm2 to calculate the bits
2823 : : size of a type and is used to position record fields. */
2824 : :
2825 : : tree
2826 : 120 : m2expr_BuildTBitSize (location_t location, tree type)
2827 : : {
2828 : 156 : enum tree_code code = TREE_CODE (type);
2829 : 156 : tree min;
2830 : 156 : tree max;
2831 : 156 : m2assert_AssertLocation (location);
2832 : :
2833 : 156 : switch (code)
2834 : : {
2835 : :
2836 : 36 : case TYPE_DECL:
2837 : 36 : return m2expr_BuildTBitSize (location, TREE_TYPE (type));
2838 : 120 : case INTEGER_TYPE:
2839 : 120 : case ENUMERAL_TYPE:
2840 : 120 : max = m2convert_BuildConvert (location, m2type_GetIntegerType (),
2841 : 120 : TYPE_MAX_VALUE (type), false);
2842 : 120 : min = m2convert_BuildConvert (location, m2type_GetIntegerType (),
2843 : 120 : TYPE_MIN_VALUE (type), false);
2844 : 120 : return m2expr_calcNbits (location, min, max);
2845 : 0 : case BOOLEAN_TYPE:
2846 : 0 : return m2expr_GetIntegerOne (location);
2847 : 0 : default:
2848 : 0 : return m2expr_BuildMult (location, m2expr_GetSizeOf (location, type),
2849 : : m2decl_BuildIntegerConstant (BITS_PER_UNIT),
2850 : 0 : false);
2851 : : }
2852 : : }
2853 : :
2854 : : /* BuildSystemTBitSize return the minimum number of bits to represent type.
2855 : : This function is called when evaluating SYSTEM.TBITSIZE. */
2856 : :
2857 : : tree
2858 : 60 : m2expr_BuildSystemTBitSize (location_t location, tree type)
2859 : : {
2860 : 60 : enum tree_code code = TREE_CODE (type);
2861 : 60 : m2assert_AssertLocation (location);
2862 : 60 : if (code == TYPE_DECL)
2863 : 12 : return m2expr_BuildTBitSize (location, TREE_TYPE (type));
2864 : 48 : return TYPE_SIZE (type);
2865 : : }
2866 : :
2867 : : /* BuildSize build a SIZE function expression and returns the tree. */
2868 : :
2869 : : tree
2870 : 472493 : m2expr_BuildSize (location_t location, tree op1,
2871 : : bool needconvert ATTRIBUTE_UNUSED)
2872 : : {
2873 : 472493 : m2assert_AssertLocation (location);
2874 : 472493 : return m2expr_GetSizeOf (location, op1);
2875 : : }
2876 : :
2877 : : /* BuildAddr return an expression which calculates the address of op1
2878 : : and returns the tree. If use_generic is true then create a generic
2879 : : pointer type. */
2880 : :
2881 : : tree
2882 : 383510 : m2expr_BuildAddr (location_t location, tree op1, bool use_generic)
2883 : : {
2884 : 383510 : tree type = m2tree_skip_type_decl (TREE_TYPE (op1));
2885 : 383510 : tree ptrType = build_pointer_type (type);
2886 : 383510 : tree result;
2887 : :
2888 : 383510 : m2assert_AssertLocation (location);
2889 : :
2890 : 383510 : if (!gm2_mark_addressable (op1))
2891 : 0 : error_at (location, "cannot take the address of this expression");
2892 : :
2893 : 383510 : if (use_generic)
2894 : 12 : result = build1 (ADDR_EXPR, m2type_GetPointerType (), op1);
2895 : : else
2896 : 383498 : result = build1 (ADDR_EXPR, ptrType, op1);
2897 : 383510 : protected_set_expr_location (result, location);
2898 : 383510 : return result;
2899 : : }
2900 : :
2901 : : /* BuildOffset1 build and return an expression containing the number
2902 : : of bytes the field is offset from the start of the record structure.
2903 : : This function is the same as the above, except that it derives the
2904 : : record from the field and then calls BuildOffset. */
2905 : :
2906 : : tree
2907 : 0 : m2expr_BuildOffset1 (location_t location, tree field,
2908 : : bool needconvert ATTRIBUTE_UNUSED)
2909 : : {
2910 : 0 : m2assert_AssertLocation (location);
2911 : 0 : return m2expr_BuildOffset (location, DECL_CONTEXT (field), field,
2912 : 0 : needconvert);
2913 : : }
2914 : :
2915 : : /* determinePenultimateField return the field associated with the
2916 : : DECL_CONTEXT (field) within a record or varient. The record, is a
2917 : : record/varient but it maybe an outer nested record to the field that
2918 : : we are searching. Ie:
2919 : :
2920 : : record = RECORD x: CARDINAL ; y: RECORD field: CARDINAL ; END END ;
2921 : :
2922 : : determinePenultimateField (record, field) returns, y. We are
2923 : : assurred that the chain of records leading to field will be unique as
2924 : : they are built on the fly to implement varient records. */
2925 : :
2926 : : static tree
2927 : 1380 : determinePenultimateField (tree record, tree field)
2928 : : {
2929 : 1380 : tree fieldlist = TYPE_FIELDS (record);
2930 : 1380 : tree x, r;
2931 : :
2932 : 2520 : for (x = fieldlist; x; x = TREE_CHAIN (x))
2933 : : {
2934 : 2370 : if (DECL_CONTEXT (field) == TREE_TYPE (x))
2935 : : return x;
2936 : 1662 : switch (TREE_CODE (TREE_TYPE (x)))
2937 : : {
2938 : 672 : case RECORD_TYPE:
2939 : 672 : case UNION_TYPE:
2940 : 672 : r = determinePenultimateField (TREE_TYPE (x), field);
2941 : 672 : if (r != NULL)
2942 : : return r;
2943 : : break;
2944 : : default:
2945 : : break;
2946 : : }
2947 : : }
2948 : : return NULL_TREE;
2949 : : }
2950 : :
2951 : : /* BuildOffset builds an expression containing the number of bytes
2952 : : the field is offset from the start of the record structure. The
2953 : : expression is returned. */
2954 : :
2955 : : tree
2956 : 0 : m2expr_BuildOffset (location_t location, tree record, tree field,
2957 : : bool needconvert ATTRIBUTE_UNUSED)
2958 : : {
2959 : 0 : m2assert_AssertLocation (location);
2960 : :
2961 : 0 : if (DECL_CONTEXT (field) == record)
2962 : 0 : return m2convert_BuildConvert (
2963 : : location, m2type_GetIntegerType (),
2964 : : m2expr_BuildAdd (
2965 : 0 : location, DECL_FIELD_OFFSET (field),
2966 : 0 : m2expr_BuildDivTrunc (location, DECL_FIELD_BIT_OFFSET (field),
2967 : : m2decl_BuildIntegerConstant (BITS_PER_UNIT),
2968 : : false),
2969 : : false),
2970 : 0 : false);
2971 : : else
2972 : : {
2973 : 0 : tree r1 = DECL_CONTEXT (field);
2974 : 0 : tree r2 = determinePenultimateField (record, field);
2975 : 0 : return m2convert_BuildConvert (
2976 : : location, m2type_GetIntegerType (),
2977 : : m2expr_BuildAdd (
2978 : : location, m2expr_BuildOffset (location, r1, field, needconvert),
2979 : : m2expr_BuildOffset (location, record, r2, needconvert), false),
2980 : 0 : false);
2981 : : }
2982 : : }
2983 : :
2984 : : /* BuildLogicalOrAddress build a logical or expressions and return the tree. */
2985 : :
2986 : : tree
2987 : 12 : m2expr_BuildLogicalOrAddress (location_t location, tree op1, tree op2,
2988 : : bool needconvert)
2989 : : {
2990 : 12 : m2assert_AssertLocation (location);
2991 : 12 : return m2expr_build_binary_op (location, BIT_IOR_EXPR, op1, op2,
2992 : 12 : needconvert);
2993 : : }
2994 : :
2995 : : /* BuildLogicalOr build a logical or expressions and return the tree. */
2996 : :
2997 : : tree
2998 : 528877 : m2expr_BuildLogicalOr (location_t location, tree op1, tree op2,
2999 : : bool needconvert)
3000 : : {
3001 : 528877 : m2assert_AssertLocation (location);
3002 : 528877 : return m2expr_build_binary_op (
3003 : : location, BIT_IOR_EXPR,
3004 : : m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
3005 : : m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
3006 : 528877 : needconvert);
3007 : : }
3008 : :
3009 : : /* BuildLogicalAnd build a logical and expression and return the tree. */
3010 : :
3011 : : tree
3012 : 995 : m2expr_BuildLogicalAnd (location_t location, tree op1, tree op2,
3013 : : bool needconvert)
3014 : : {
3015 : 995 : m2assert_AssertLocation (location);
3016 : 995 : return m2expr_build_binary_op (
3017 : : location, BIT_AND_EXPR,
3018 : : m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
3019 : : m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
3020 : 995 : needconvert);
3021 : : }
3022 : :
3023 : : /* BuildSymmetricalDifference build a logical xor expression and return the
3024 : : * tree. */
3025 : :
3026 : : tree
3027 : 12 : m2expr_BuildSymmetricDifference (location_t location, tree op1, tree op2,
3028 : : bool needconvert)
3029 : : {
3030 : 12 : m2assert_AssertLocation (location);
3031 : 12 : return m2expr_build_binary_op (
3032 : : location, BIT_XOR_EXPR,
3033 : : m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
3034 : : m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
3035 : 12 : needconvert);
3036 : : }
3037 : :
3038 : : /* BuildLogicalDifference build a logical difference expression and
3039 : : return the tree. (op1 and (not op2)). */
3040 : :
3041 : : tree
3042 : 84 : m2expr_BuildLogicalDifference (location_t location, tree op1, tree op2,
3043 : : bool needconvert)
3044 : : {
3045 : 84 : m2assert_AssertLocation (location);
3046 : 84 : return m2expr_build_binary_op (
3047 : : location, BIT_AND_EXPR,
3048 : : m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
3049 : 84 : m2expr_BuildSetNegate (location, op2, needconvert), needconvert);
3050 : : }
3051 : :
3052 : : /* base_type returns the base type of an ordinal subrange, or the
3053 : : type itself if it is not a subrange. */
3054 : :
3055 : : static tree
3056 : 841572 : base_type (tree type)
3057 : : {
3058 : 841572 : if (type == error_mark_node)
3059 : : return error_mark_node;
3060 : :
3061 : : /* Check for ordinal subranges. */
3062 : 841572 : if (m2tree_IsOrdinal (type) && TREE_TYPE (type))
3063 : 117708 : type = TREE_TYPE (type);
3064 : 841572 : return TYPE_MAIN_VARIANT (type);
3065 : : }
3066 : :
3067 : : /* boolean_enum_to_unsigned convert a BOOLEAN_TYPE, t, or
3068 : : ENUMERAL_TYPE to an unsigned type. */
3069 : :
3070 : : static tree
3071 : 434346 : boolean_enum_to_unsigned (location_t location, tree t)
3072 : : {
3073 : 434346 : tree type = TREE_TYPE (t);
3074 : :
3075 : 434346 : if (TREE_CODE (base_type (type)) == BOOLEAN_TYPE)
3076 : 27120 : return m2convert_BuildConvert (location, unsigned_type_node, t, false);
3077 : 407226 : else if (TREE_CODE (base_type (type)) == ENUMERAL_TYPE)
3078 : 1392 : return m2convert_BuildConvert (location, unsigned_type_node, t, false);
3079 : : else
3080 : : return t;
3081 : : }
3082 : :
3083 : : /* check_for_comparison check to see if, op, is of type, badType. If
3084 : : so then it returns op after it has been cast to, goodType. op will
3085 : : be an array so we take the address and cast the contents. */
3086 : :
3087 : : static tree
3088 : 751784 : check_for_comparison (location_t location, tree op, tree badType,
3089 : : tree goodType)
3090 : : {
3091 : 751784 : m2assert_AssertLocation (location);
3092 : 751784 : if (m2tree_skip_type_decl (TREE_TYPE (op)) == badType)
3093 : : /* Cannot compare array contents in m2expr_build_binary_op. */
3094 : 0 : return m2expr_BuildIndirect (
3095 : 0 : location, m2expr_BuildAddr (location, op, false), goodType);
3096 : : return op;
3097 : : }
3098 : :
3099 : : /* convert_for_comparison return a tree which can be used as an
3100 : : argument during a comparison. */
3101 : :
3102 : : static tree
3103 : 187946 : convert_for_comparison (location_t location, tree op)
3104 : : {
3105 : 187946 : m2assert_AssertLocation (location);
3106 : 187946 : op = boolean_enum_to_unsigned (location, op);
3107 : :
3108 : 187946 : op = check_for_comparison (location, op, m2type_GetISOWordType (),
3109 : : m2type_GetWordType ());
3110 : 187946 : op = check_for_comparison (location, op, m2type_GetM2Word16 (),
3111 : : m2type_GetM2Cardinal16 ());
3112 : 187946 : op = check_for_comparison (location, op, m2type_GetM2Word32 (),
3113 : : m2type_GetM2Cardinal32 ());
3114 : 187946 : op = check_for_comparison (location, op, m2type_GetM2Word64 (),
3115 : : m2type_GetM2Cardinal64 ());
3116 : :
3117 : 187946 : return op;
3118 : : }
3119 : :
3120 : : /* BuildLessThan return a tree which computes <. */
3121 : :
3122 : : tree
3123 : 53922 : m2expr_BuildLessThan (location_t location, tree op1, tree op2)
3124 : : {
3125 : 53922 : m2assert_AssertLocation (location);
3126 : 53922 : return m2expr_build_binary_op (
3127 : : location, LT_EXPR, boolean_enum_to_unsigned (location, op1),
3128 : 53922 : boolean_enum_to_unsigned (location, op2), true);
3129 : : }
3130 : :
3131 : : /* BuildGreaterThan return a tree which computes >. */
3132 : :
3133 : : tree
3134 : 51713 : m2expr_BuildGreaterThan (location_t location, tree op1, tree op2)
3135 : : {
3136 : 51713 : m2assert_AssertLocation (location);
3137 : 51713 : return m2expr_build_binary_op (
3138 : : location, GT_EXPR, boolean_enum_to_unsigned (location, op1),
3139 : 51713 : boolean_enum_to_unsigned (location, op2), true);
3140 : : }
3141 : :
3142 : : /* BuildLessThanOrEqual return a tree which computes <. */
3143 : :
3144 : : tree
3145 : 7651 : m2expr_BuildLessThanOrEqual (location_t location, tree op1, tree op2)
3146 : : {
3147 : 7651 : m2assert_AssertLocation (location);
3148 : 7651 : return m2expr_build_binary_op (
3149 : : location, LE_EXPR, boolean_enum_to_unsigned (location, op1),
3150 : 7651 : boolean_enum_to_unsigned (location, op2), true);
3151 : : }
3152 : :
3153 : : /* BuildGreaterThanOrEqual return a tree which computes >=. */
3154 : :
3155 : : tree
3156 : 9914 : m2expr_BuildGreaterThanOrEqual (location_t location, tree op1, tree op2)
3157 : : {
3158 : 9914 : m2assert_AssertLocation (location);
3159 : 9914 : return m2expr_build_binary_op (
3160 : : location, GE_EXPR, boolean_enum_to_unsigned (location, op1),
3161 : 9914 : boolean_enum_to_unsigned (location, op2), true);
3162 : : }
3163 : :
3164 : : /* BuildEqualTo return a tree which computes =. */
3165 : :
3166 : : tree
3167 : 56165 : m2expr_BuildEqualTo (location_t location, tree op1, tree op2)
3168 : : {
3169 : 56165 : m2assert_AssertLocation (location);
3170 : 56165 : return m2expr_build_binary_op (location, EQ_EXPR,
3171 : : convert_for_comparison (location, op1),
3172 : 56165 : convert_for_comparison (location, op2), true);
3173 : : }
3174 : :
3175 : : /* BuildEqualNotTo return a tree which computes #. */
3176 : :
3177 : : tree
3178 : 37808 : m2expr_BuildNotEqualTo (location_t location, tree op1, tree op2)
3179 : : {
3180 : 37808 : m2assert_AssertLocation (location);
3181 : 37808 : return m2expr_build_binary_op (location, NE_EXPR,
3182 : : convert_for_comparison (location, op1),
3183 : 37808 : convert_for_comparison (location, op2), true);
3184 : : }
3185 : :
3186 : : /* BuildIsSuperset return a tree which computes: op1 & op2 == op2. */
3187 : :
3188 : : tree
3189 : 24 : m2expr_BuildIsSuperset (location_t location, tree op1, tree op2)
3190 : : {
3191 : 24 : m2assert_AssertLocation (location);
3192 : 24 : return m2expr_BuildEqualTo (
3193 : 24 : location, op2, m2expr_BuildLogicalAnd (location, op1, op2, false));
3194 : : }
3195 : :
3196 : : /* BuildIsNotSuperset return a tree which computes: op1 & op2 != op2. */
3197 : :
3198 : : tree
3199 : 24 : m2expr_BuildIsNotSuperset (location_t location, tree op1, tree op2)
3200 : : {
3201 : 24 : m2assert_AssertLocation (location);
3202 : 24 : return m2expr_BuildNotEqualTo (
3203 : 24 : location, op2, m2expr_BuildLogicalAnd (location, op1, op2, false));
3204 : : }
3205 : :
3206 : : /* BuildIsSubset return a tree which computes: op1 & op2 == op1. */
3207 : :
3208 : : tree
3209 : 0 : m2expr_BuildIsSubset (location_t location, tree op1, tree op2)
3210 : : {
3211 : 0 : m2assert_AssertLocation (location);
3212 : 0 : return m2expr_BuildEqualTo (
3213 : 0 : location, op1, m2expr_BuildLogicalAnd (location, op1, op2, false));
3214 : : }
3215 : :
3216 : : /* BuildIsNotSubset return a tree which computes: op1 & op2 != op1. */
3217 : :
3218 : : tree
3219 : 24 : m2expr_BuildIsNotSubset (location_t location, tree op1, tree op2)
3220 : : {
3221 : 24 : m2assert_AssertLocation (location);
3222 : 24 : return m2expr_BuildNotEqualTo (
3223 : 24 : location, op1, m2expr_BuildLogicalAnd (location, op1, op2, false));
3224 : : }
3225 : :
3226 : : /* BuildIfConstInVar generates: if constel in varset then goto label. */
3227 : :
3228 : : void
3229 : 168 : m2expr_BuildIfConstInVar (location_t location, tree type, tree varset,
3230 : : tree constel, bool is_lvalue, int fieldno,
3231 : : char *label)
3232 : : {
3233 : 168 : tree size = m2expr_GetSizeOf (location, type);
3234 : 168 : m2assert_AssertLocation (location);
3235 : :
3236 : 168 : ASSERT_BOOL (is_lvalue);
3237 : 168 : if (m2expr_CompareTrees (
3238 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
3239 : : <= 0)
3240 : : /* Small set size <= TSIZE(WORD). */
3241 : 114 : m2treelib_do_jump_if_bit (
3242 : : location, NE_EXPR,
3243 : : m2treelib_get_rvalue (location, varset, type, is_lvalue), constel,
3244 : : label);
3245 : : else
3246 : : {
3247 : 54 : tree fieldlist = TYPE_FIELDS (type);
3248 : 54 : tree field;
3249 : :
3250 : 84 : for (field = fieldlist; (field != NULL) && (fieldno > 0);
3251 : 30 : field = TREE_CHAIN (field))
3252 : 30 : fieldno--;
3253 : :
3254 : 54 : m2treelib_do_jump_if_bit (
3255 : : location, NE_EXPR,
3256 : : m2treelib_get_set_field_rhs (location, varset, field), constel,
3257 : : label);
3258 : : }
3259 : 168 : }
3260 : :
3261 : : /* BuildIfConstInVar generates: if not (constel in varset) then goto label. */
3262 : :
3263 : : void
3264 : 700 : m2expr_BuildIfNotConstInVar (location_t location, tree type, tree varset,
3265 : : tree constel, bool is_lvalue, int fieldno,
3266 : : char *label)
3267 : : {
3268 : 700 : tree size = m2expr_GetSizeOf (location, type);
3269 : :
3270 : 700 : m2assert_AssertLocation (location);
3271 : :
3272 : 700 : ASSERT_BOOL (is_lvalue);
3273 : 700 : if (m2expr_CompareTrees (
3274 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
3275 : : <= 0)
3276 : : /* Small set size <= TSIZE(WORD). */
3277 : 544 : m2treelib_do_jump_if_bit (
3278 : : location, EQ_EXPR,
3279 : : m2treelib_get_rvalue (location, varset, type, is_lvalue), constel,
3280 : : label);
3281 : : else
3282 : : {
3283 : 156 : tree fieldlist = TYPE_FIELDS (type);
3284 : 156 : tree field;
3285 : :
3286 : 186 : for (field = fieldlist; (field != NULL) && (fieldno > 0);
3287 : 30 : field = TREE_CHAIN (field))
3288 : 30 : fieldno--;
3289 : :
3290 : 156 : m2treelib_do_jump_if_bit (
3291 : : location, EQ_EXPR,
3292 : : m2treelib_get_set_field_rhs (location, varset, field), constel,
3293 : : label);
3294 : : }
3295 : 700 : }
3296 : :
3297 : : /* BuildIfVarInVar generates: if varel in varset then goto label. */
3298 : :
3299 : : void
3300 : 198 : m2expr_BuildIfVarInVar (location_t location, tree type, tree varset,
3301 : : tree varel, bool is_lvalue, tree low,
3302 : : tree high ATTRIBUTE_UNUSED, char *label)
3303 : : {
3304 : 198 : tree size = m2expr_GetSizeOf (location, type);
3305 : : /* Calculate the index from the first bit, ie bit 0 represents low value. */
3306 : 198 : tree index = m2expr_BuildSub (
3307 : : location, m2convert_BuildConvert (location, m2type_GetIntegerType (),
3308 : : varel, false),
3309 : : m2convert_BuildConvert (location, m2type_GetIntegerType (), low, false),
3310 : : false);
3311 : :
3312 : 198 : m2assert_AssertLocation (location);
3313 : :
3314 : 198 : if (m2expr_CompareTrees (
3315 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
3316 : : <= 0)
3317 : : /* Small set size <= TSIZE(WORD). */
3318 : 60 : m2treelib_do_jump_if_bit (
3319 : : location, NE_EXPR,
3320 : : m2treelib_get_rvalue (location, varset, type, is_lvalue), index,
3321 : : label);
3322 : : else
3323 : : {
3324 : 138 : tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
3325 : : /* Which word do we need to fetch? */
3326 : 138 : tree word_index = m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
3327 : : location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
3328 : : false));
3329 : : /* Calculate the bit in this word. */
3330 : 138 : tree offset_into_word = m2expr_FoldAndStrip (m2expr_BuildModTrunc (
3331 : : location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
3332 : : false));
3333 : 138 : tree p2 = m2expr_FoldAndStrip (m2expr_BuildMult (
3334 : : location, word_index,
3335 : : m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT), false));
3336 : :
3337 : : /* Calculate the address of the word we are interested in. */
3338 : 138 : p1 = m2expr_BuildAddAddress (location,
3339 : : m2convert_convertToPtr (location, p1), p2);
3340 : :
3341 : : /* Fetch the word, extract the bit and test for != 0. */
3342 : 138 : m2treelib_do_jump_if_bit (
3343 : : location, NE_EXPR,
3344 : : m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
3345 : : offset_into_word, label);
3346 : : }
3347 : 198 : }
3348 : :
3349 : : /* BuildIfNotVarInVar generates: if not (varel in varset) then goto label. */
3350 : :
3351 : : void
3352 : 502 : m2expr_BuildIfNotVarInVar (location_t location, tree type, tree varset,
3353 : : tree varel, bool is_lvalue, tree low,
3354 : : tree high ATTRIBUTE_UNUSED, char *label)
3355 : : {
3356 : 502 : tree size = m2expr_GetSizeOf (location, type);
3357 : : /* Calculate the index from the first bit, ie bit 0 represents low value. */
3358 : 502 : tree index = m2expr_BuildSub (
3359 : : location, m2convert_BuildConvert (location, m2type_GetIntegerType (),
3360 : : m2expr_FoldAndStrip (varel), false),
3361 : : m2convert_BuildConvert (location, m2type_GetIntegerType (),
3362 : : m2expr_FoldAndStrip (low), false),
3363 : : false);
3364 : :
3365 : 502 : index = m2expr_FoldAndStrip (index);
3366 : 502 : m2assert_AssertLocation (location);
3367 : :
3368 : 502 : if (m2expr_CompareTrees (
3369 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
3370 : : <= 0)
3371 : : /* Small set size <= TSIZE(WORD). */
3372 : 210 : m2treelib_do_jump_if_bit (
3373 : : location, EQ_EXPR,
3374 : : m2treelib_get_rvalue (location, varset, type, is_lvalue), index,
3375 : : label);
3376 : : else
3377 : : {
3378 : 292 : tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
3379 : : /* Calculate the index from the first bit. */
3380 : :
3381 : : /* Which word do we need to fetch? */
3382 : 292 : tree word_index = m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
3383 : : location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
3384 : : false));
3385 : : /* Calculate the bit in this word. */
3386 : 292 : tree offset_into_word = m2expr_FoldAndStrip (m2expr_BuildModTrunc (
3387 : : location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
3388 : : false));
3389 : 292 : tree p2 = m2expr_FoldAndStrip (m2expr_BuildMult (
3390 : : location, word_index,
3391 : : m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT), false));
3392 : :
3393 : : /* Calculate the address of the word we are interested in. */
3394 : 292 : p1 = m2expr_BuildAddAddress (location, p1, p2);
3395 : :
3396 : : /* Fetch the word, extract the bit and test for == 0. */
3397 : 292 : m2treelib_do_jump_if_bit (
3398 : : location, EQ_EXPR,
3399 : : m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
3400 : : offset_into_word, label);
3401 : : }
3402 : 502 : }
3403 : :
3404 : : /* BuildForeachWordInSetDoIfExpr foreach word in set, type, compute
3405 : : the expression, expr, and if true goto label. */
3406 : :
3407 : : void
3408 : 504 : m2expr_BuildForeachWordInSetDoIfExpr (location_t location, tree type, tree op1,
3409 : : tree op2, bool is_op1lvalue,
3410 : : bool is_op2lvalue, bool is_op1const,
3411 : : bool is_op2const,
3412 : : tree (*expr) (location_t, tree, tree),
3413 : : char *label)
3414 : : {
3415 : 504 : tree p1 = m2treelib_get_set_address_if_var (location, op1, is_op1lvalue,
3416 : : is_op1const);
3417 : 504 : tree p2 = m2treelib_get_set_address_if_var (location, op2, is_op2lvalue,
3418 : : is_op2const);
3419 : 504 : unsigned int fieldNo = 0;
3420 : 504 : tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
3421 : 504 : tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
3422 : :
3423 : 504 : m2assert_AssertLocation (location);
3424 : 504 : ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op1)) == RECORD_TYPE);
3425 : 504 : ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op2)) == RECORD_TYPE);
3426 : :
3427 : 7248 : while (field1 != NULL && field2 != NULL)
3428 : : {
3429 : 6744 : m2statement_DoJump (
3430 : : location,
3431 : : (*expr) (location,
3432 : : m2treelib_get_set_value (location, p1, field1, is_op1const,
3433 : : is_op1lvalue, op1, fieldNo),
3434 : : m2treelib_get_set_value (location, p2, field2, is_op2const,
3435 : : is_op2lvalue, op2, fieldNo)),
3436 : : NULL, label);
3437 : 6744 : fieldNo++;
3438 : 6744 : field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
3439 : 6744 : field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
3440 : : }
3441 : 504 : }
3442 : :
3443 : : /* BuildIfInRangeGoto returns a tree containing if var is in the
3444 : : range low..high then goto label. */
3445 : :
3446 : : void
3447 : 80 : m2expr_BuildIfInRangeGoto (location_t location, tree var, tree low, tree high,
3448 : : char *label)
3449 : : {
3450 : 80 : m2assert_AssertLocation (location);
3451 : :
3452 : 80 : if (m2expr_CompareTrees (low, high) == 0)
3453 : 60 : m2statement_DoJump (location, m2expr_BuildEqualTo (location, var, low),
3454 : : NULL, label);
3455 : : else
3456 : 20 : m2statement_DoJump (
3457 : : location,
3458 : : m2expr_build_binary_op (
3459 : : location, TRUTH_ANDIF_EXPR,
3460 : : m2expr_BuildGreaterThanOrEqual (location, var, low),
3461 : : m2expr_BuildLessThanOrEqual (location, var, high), false),
3462 : : NULL, label);
3463 : 80 : }
3464 : :
3465 : : /* BuildIfNotInRangeGoto returns a tree containing if var is not in
3466 : : the range low..high then goto label. */
3467 : :
3468 : : void
3469 : 34 : m2expr_BuildIfNotInRangeGoto (location_t location, tree var, tree low,
3470 : : tree high, char *label)
3471 : : {
3472 : 34 : m2assert_AssertLocation (location);
3473 : :
3474 : 34 : if (m2expr_CompareTrees (low, high) == 0)
3475 : 0 : m2statement_DoJump (location, m2expr_BuildNotEqualTo (location, var, low),
3476 : : NULL, label);
3477 : : else
3478 : 34 : m2statement_DoJump (
3479 : : location, m2expr_build_binary_op (
3480 : : location, TRUTH_ORIF_EXPR,
3481 : : m2expr_BuildLessThan (location, var, low),
3482 : : m2expr_BuildGreaterThan (location, var, high), false),
3483 : : NULL, label);
3484 : 34 : }
3485 : :
3486 : : /* BuildArray - returns a tree which accesses array[index] given,
3487 : : lowIndice. */
3488 : :
3489 : : tree
3490 : 42006 : m2expr_BuildArray (location_t location, tree type, tree array, tree index,
3491 : : tree low_indice)
3492 : : {
3493 : 42006 : tree array_type = m2tree_skip_type_decl (TREE_TYPE (array));
3494 : 42006 : tree index_type = TYPE_DOMAIN (array_type);
3495 : 42006 : type = m2tree_skip_type_decl (type);
3496 : : // ASSERT_CONDITION (low_indice == TYPE_MIN_VALUE (index_type));
3497 : :
3498 : 42006 : low_indice
3499 : 42006 : = m2convert_BuildConvert (location, index_type, low_indice, false);
3500 : 42006 : return build4_loc (location, ARRAY_REF, type, array, index, low_indice,
3501 : 42006 : NULL_TREE);
3502 : : }
3503 : :
3504 : : /* BuildComponentRef - build a component reference tree which
3505 : : accesses record.field. If field does not belong to record it
3506 : : calls BuildComponentRef on the penultimate field. */
3507 : :
3508 : : tree
3509 : 208123 : m2expr_BuildComponentRef (location_t location, tree record, tree field)
3510 : : {
3511 : 208831 : tree recordType = m2tree_skip_reference_type (
3512 : 208831 : m2tree_skip_type_decl (TREE_TYPE (record)));
3513 : :
3514 : 208831 : if (DECL_CONTEXT (field) == recordType)
3515 : 208123 : return build3 (COMPONENT_REF, TREE_TYPE (field), record, field, NULL_TREE);
3516 : : else
3517 : : {
3518 : 708 : tree f = determinePenultimateField (recordType, field);
3519 : 708 : return m2expr_BuildComponentRef (
3520 : 708 : location, m2expr_BuildComponentRef (location, record, f), field);
3521 : : }
3522 : : }
3523 : :
3524 : : /* BuildIndirect - build: (*target) given that the object to be
3525 : : copied is of, type. */
3526 : :
3527 : : tree
3528 : 102547 : m2expr_BuildIndirect (location_t location ATTRIBUTE_UNUSED, tree target,
3529 : : tree type)
3530 : : {
3531 : : /* Note that the second argument to build1 is:
3532 : :
3533 : : TYPE_QUALS is a list of modifiers such as const or volatile to apply
3534 : : to the pointer type, represented as identifiers.
3535 : :
3536 : : it also determines the type of arithmetic and size of the object to
3537 : : be indirectly moved. */
3538 : :
3539 : 102547 : tree t1 = m2tree_skip_type_decl (type);
3540 : 102547 : tree t2 = build_pointer_type (t1);
3541 : :
3542 : 102547 : m2assert_AssertLocation (location);
3543 : :
3544 : 102547 : return build1 (INDIRECT_REF, t1,
3545 : 102547 : m2convert_BuildConvert (location, t2, target, false));
3546 : : }
3547 : :
3548 : : /* IsTrue - returns true if, t, is known to be true. */
3549 : :
3550 : : bool
3551 : 49696 : m2expr_IsTrue (tree t)
3552 : : {
3553 : 49696 : return (m2expr_FoldAndStrip (t) == m2type_GetBooleanTrue ());
3554 : : }
3555 : :
3556 : : /* IsFalse - returns false if, t, is known to be false. */
3557 : :
3558 : : bool
3559 : 0 : m2expr_IsFalse (tree t)
3560 : : {
3561 : 0 : return (m2expr_FoldAndStrip (t) == m2type_GetBooleanFalse ());
3562 : : }
3563 : :
3564 : : /* AreConstantsEqual - maps onto tree.cc (tree_int_cst_equal). It
3565 : : returns true if the value of e1 is the same as e2. */
3566 : :
3567 : : bool
3568 : 1259481 : m2expr_AreConstantsEqual (tree e1, tree e2)
3569 : : {
3570 : 1259481 : return tree_int_cst_equal (e1, e2) != 0;
3571 : : }
3572 : :
3573 : : /* AreRealOrComplexConstantsEqual - returns true if constants, e1 and
3574 : : e2 are equal according to IEEE rules. This does not perform bit
3575 : : equivalence for example IEEE states that -0 == 0 and NaN != NaN. */
3576 : :
3577 : : bool
3578 : 162 : m2expr_AreRealOrComplexConstantsEqual (tree e1, tree e2)
3579 : : {
3580 : 162 : if (TREE_CODE (e1) == COMPLEX_CST)
3581 : 54 : return (m2expr_AreRealOrComplexConstantsEqual (TREE_REALPART (e1),
3582 : 54 : TREE_REALPART (e2))
3583 : 108 : && m2expr_AreRealOrComplexConstantsEqual (TREE_IMAGPART (e1),
3584 : 54 : TREE_IMAGPART (e2)));
3585 : : else
3586 : 108 : return real_compare (EQ_EXPR, &TREE_REAL_CST (e1), &TREE_REAL_CST (e2));
3587 : : }
3588 : :
3589 : : /* DetermineSign, returns -1 if e<0 0 if e==0 1 if e>0
3590 : : an unsigned constant will never return -1. */
3591 : :
3592 : : int
3593 : 0 : m2expr_DetermineSign (tree e)
3594 : : {
3595 : 0 : return tree_int_cst_sgn (e);
3596 : : }
3597 : :
3598 : : /* Similar to build_int_2 () but allows you to specify the type of
3599 : : the integer constant that you are creating. */
3600 : :
3601 : : static tree
3602 : 318 : build_int_2_type (HOST_WIDE_INT low, HOST_WIDE_INT hi, tree type)
3603 : : {
3604 : 318 : tree value;
3605 : 318 : HOST_WIDE_INT ival[3];
3606 : :
3607 : 318 : ival[0] = low;
3608 : 318 : ival[1] = hi;
3609 : 318 : ival[2] = 0;
3610 : :
3611 : 318 : widest_int wval = widest_int::from_array (ival, 3);
3612 : 318 : value = wide_int_to_tree (type, wval);
3613 : :
3614 : 318 : return value;
3615 : 318 : }
3616 : :
3617 : : /* BuildCap - builds the Modula-2 function CAP(t) and returns the
3618 : : result in a gcc Tree. */
3619 : :
3620 : : tree
3621 : 106 : m2expr_BuildCap (location_t location, tree t)
3622 : : {
3623 : 106 : tree tt;
3624 : 106 : tree out_of_range, less_than, greater_than, translated;
3625 : :
3626 : 106 : m2assert_AssertLocation (location);
3627 : :
3628 : 106 : t = fold (t);
3629 : 106 : if (t == error_mark_node)
3630 : : return error_mark_node;
3631 : :
3632 : 106 : tt = TREE_TYPE (t);
3633 : :
3634 : 106 : t = fold (convert (m2type_GetM2CharType (), t));
3635 : :
3636 : 106 : if (TREE_CODE (tt) == INTEGER_TYPE)
3637 : : {
3638 : 106 : less_than = fold (m2expr_build_binary_op (
3639 : : location, LT_EXPR, t,
3640 : : build_int_2_type ('a', 0, m2type_GetM2CharType ()), 0));
3641 : 106 : greater_than = fold (m2expr_build_binary_op (
3642 : : location, GT_EXPR, t,
3643 : : build_int_2_type ('z', 0, m2type_GetM2CharType ()), 0));
3644 : 106 : out_of_range = fold (m2expr_build_binary_op (
3645 : : location, TRUTH_ORIF_EXPR, less_than, greater_than, 0));
3646 : :
3647 : 106 : translated = fold (convert (
3648 : : m2type_GetM2CharType (),
3649 : : m2expr_build_binary_op (
3650 : : location, MINUS_EXPR, t,
3651 : : build_int_2_type ('a' - 'A', 0, m2type_GetM2CharType ()), 0)));
3652 : :
3653 : 106 : return fold_build3 (COND_EXPR, m2type_GetM2CharType (), out_of_range, t,
3654 : : translated);
3655 : : }
3656 : :
3657 : 0 : error_at (location,
3658 : : "argument to CAP is not a constant or variable of type CHAR");
3659 : 0 : return error_mark_node;
3660 : : }
3661 : :
3662 : : /* BuildDivM2 if iso or pim4 then all modulus results are positive
3663 : : and the results from the division are rounded to the floor otherwise
3664 : : use BuildDivTrunc. */
3665 : :
3666 : : tree
3667 : 4004 : m2expr_BuildDivM2 (location_t location, tree op1, tree op2,
3668 : : bool needsconvert)
3669 : : {
3670 : 4004 : op1 = m2expr_FoldAndStrip (op1);
3671 : 4004 : op2 = m2expr_FoldAndStrip (op2);
3672 : 4004 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3673 : : /* If iso or pim4 then build and return ((op2 < 0) ? (op1
3674 : : divceil op2) : (op1 divfloor op2)) otherwise use divtrunc. */
3675 : 4032 : if (M2Options_GetPIM4 () || M2Options_GetISO ()
3676 : 4032 : || M2Options_GetPositiveModFloor ())
3677 : 3976 : return fold_build3 (
3678 : : COND_EXPR, TREE_TYPE (op1),
3679 : : m2expr_BuildLessThan (
3680 : : location, op2,
3681 : : m2convert_BuildConvert (location, TREE_TYPE (op2),
3682 : : m2expr_GetIntegerZero (location), false)),
3683 : : m2expr_BuildDivCeil (location, op1, op2, needsconvert),
3684 : : m2expr_BuildDivFloor (location, op1, op2, needsconvert));
3685 : : else
3686 : 28 : return m2expr_BuildDivTrunc (location, op1, op2, needsconvert);
3687 : : }
3688 : :
3689 : : /* BuildDivM2Check - build and
3690 : : return ((op2 < 0) ? (op1 divtrunc op2) : (op1 divfloor op2))
3691 : : when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
3692 : : return op1 div trunc op2. Use the checking div equivalents. */
3693 : :
3694 : : tree
3695 : 1771 : m2expr_BuildDivM2Check (location_t location, tree op1, tree op2,
3696 : : tree lowest, tree min, tree max)
3697 : : {
3698 : 1771 : op1 = m2expr_FoldAndStrip (op1);
3699 : 1771 : op2 = m2expr_FoldAndStrip (op2);
3700 : 1771 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3701 : 1771 : if (M2Options_GetISO ()
3702 : 1771 : || M2Options_GetPIM4 () || M2Options_GetPositiveModFloor ())
3703 : 1739 : return fold_build3 (
3704 : : COND_EXPR, TREE_TYPE (op1),
3705 : : m2expr_BuildLessThan (
3706 : : location, op2,
3707 : : m2convert_BuildConvert (location, TREE_TYPE (op2),
3708 : : m2expr_GetIntegerZero (location), false)),
3709 : : m2expr_BuildDivCeilCheck (location, op1, op2, lowest, min, max),
3710 : : m2expr_BuildDivFloorCheck (location, op1, op2, lowest, min, max));
3711 : : else
3712 : 32 : return m2expr_BuildDivTruncCheck (location, op1, op2, lowest, min, max);
3713 : : }
3714 : :
3715 : : static
3716 : : tree
3717 : 1878 : m2expr_BuildISOModM2Check (location_t location,
3718 : : tree op1, tree op2, tree lowest, tree min, tree max)
3719 : : {
3720 : 3756 : tree cond = m2expr_BuildLessThan (location, op2,
3721 : 1878 : m2convert_BuildConvert (location, TREE_TYPE (op2),
3722 : : m2expr_GetIntegerZero (location), false));
3723 : :
3724 : : /* Return the result of the modulus. */
3725 : 1878 : return fold_build3 (COND_EXPR, TREE_TYPE (op1), cond,
3726 : : /* op2 < 0. */
3727 : : m2expr_BuildModCeilCheck (location, op1, op2, lowest, min, max),
3728 : : /* op2 >= 0. */
3729 : : m2expr_BuildModFloorCheck (location, op1, op2, lowest, min, max));
3730 : : }
3731 : :
3732 : :
3733 : : /* BuildModM2Check if iso or pim4 then build and return ((op2 < 0) ? (op1
3734 : : modceil op2) : (op1 modfloor op2)) otherwise use modtrunc.
3735 : : Use the checking mod equivalents. */
3736 : :
3737 : : tree
3738 : 1882 : m2expr_BuildModM2Check (location_t location, tree op1, tree op2,
3739 : : tree lowest, tree min, tree max)
3740 : : {
3741 : 1882 : op1 = m2expr_FoldAndStrip (op1);
3742 : 1882 : op2 = m2expr_FoldAndStrip (op2);
3743 : 1882 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3744 : 1886 : if (M2Options_GetPIM4 () || M2Options_GetISO ()
3745 : 1886 : || M2Options_GetPositiveModFloor ())
3746 : 1878 : return m2expr_BuildISOModM2Check (location, op1, op2, lowest, min, max);
3747 : : else
3748 : 4 : return m2expr_BuildModTruncCheck (location, op1, op2, lowest, min, max);
3749 : : }
3750 : :
3751 : : /* BuildModM2 if iso or pim4 then build and return ((op2 < 0) ? (op1
3752 : : modceil op2) : (op1 modfloor op2)) otherwise use modtrunc. */
3753 : :
3754 : : tree
3755 : 250 : m2expr_BuildModM2 (location_t location, tree op1, tree op2,
3756 : : bool needsconvert)
3757 : : {
3758 : 250 : op1 = m2expr_FoldAndStrip (op1);
3759 : 250 : op2 = m2expr_FoldAndStrip (op2);
3760 : 250 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3761 : 322 : if (M2Options_GetPIM4 () || M2Options_GetISO ()
3762 : 322 : || M2Options_GetPositiveModFloor ())
3763 : 178 : return fold_build3 (
3764 : : COND_EXPR, TREE_TYPE (op1),
3765 : : m2expr_BuildLessThan (
3766 : : location, op2,
3767 : : m2convert_BuildConvert (location, TREE_TYPE (op2),
3768 : : m2expr_GetIntegerZero (location), false)),
3769 : : m2expr_BuildModCeil (location, op1, op2, needsconvert),
3770 : : m2expr_BuildModFloor (location, op1, op2, needsconvert));
3771 : : else
3772 : 72 : return m2expr_BuildModTrunc (location, op1, op2, needsconvert);
3773 : : }
3774 : :
3775 : : /* BuildAbs build the Modula-2 function ABS(t) and return the result
3776 : : in a gcc Tree. */
3777 : :
3778 : : tree
3779 : 992 : m2expr_BuildAbs (location_t location, tree t)
3780 : : {
3781 : 992 : m2assert_AssertLocation (location);
3782 : :
3783 : 992 : return m2expr_build_unary_op (location, ABS_EXPR, t, 0);
3784 : : }
3785 : :
3786 : : /* BuildRe build an expression for the function RE. */
3787 : :
3788 : : tree
3789 : 54 : m2expr_BuildRe (tree op1)
3790 : : {
3791 : 54 : op1 = m2expr_FoldAndStrip (op1);
3792 : 54 : if (TREE_CODE (op1) == COMPLEX_CST)
3793 : 36 : return fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3794 : : else
3795 : 18 : return build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3796 : : }
3797 : :
3798 : : /* BuildIm build an expression for the function IM. */
3799 : :
3800 : : tree
3801 : 54 : m2expr_BuildIm (tree op1)
3802 : : {
3803 : 54 : op1 = m2expr_FoldAndStrip (op1);
3804 : 54 : if (TREE_CODE (op1) == COMPLEX_CST)
3805 : 36 : return fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3806 : : else
3807 : 18 : return build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3808 : : }
3809 : :
3810 : : /* BuildCmplx build an expression for the function CMPLX. */
3811 : :
3812 : : tree
3813 : 486 : m2expr_BuildCmplx (location_t location, tree type, tree real, tree imag)
3814 : : {
3815 : 486 : tree scalor;
3816 : 486 : real = m2expr_FoldAndStrip (real);
3817 : 486 : imag = m2expr_FoldAndStrip (imag);
3818 : 486 : type = m2tree_skip_type_decl (type);
3819 : 486 : scalor = TREE_TYPE (type);
3820 : :
3821 : 486 : if (scalor != TREE_TYPE (real))
3822 : 6 : real = m2convert_BuildConvert (location, scalor, real, false);
3823 : 486 : if (scalor != TREE_TYPE (imag))
3824 : 18 : imag = m2convert_BuildConvert (location, scalor, imag, false);
3825 : :
3826 : 486 : if ((TREE_CODE (real) == REAL_CST) && (TREE_CODE (imag) == REAL_CST))
3827 : 408 : return build_complex (type, real, imag);
3828 : : else
3829 : 78 : return build2 (COMPLEX_EXPR, type, real, imag);
3830 : : }
3831 : :
3832 : : /* BuildBinaryForeachWordDo implements the large set operators. Each
3833 : : word of the set can be calculated by binop. This function runs along
3834 : : each word of the large set invoking the binop. */
3835 : :
3836 : : void
3837 : 1052 : m2expr_BuildBinaryForeachWordDo (location_t location, tree type, tree op1,
3838 : : tree op2, tree op3,
3839 : : tree (*binop) (location_t, tree, tree, bool),
3840 : : bool is_op1lvalue, bool is_op2lvalue,
3841 : : bool is_op3lvalue, bool is_op1const,
3842 : : bool is_op2const, bool is_op3const)
3843 : : {
3844 : 1052 : tree size = m2expr_GetSizeOf (location, type);
3845 : :
3846 : 1052 : m2assert_AssertLocation (location);
3847 : :
3848 : 1052 : ASSERT_BOOL (is_op1lvalue);
3849 : 1052 : ASSERT_BOOL (is_op2lvalue);
3850 : 1052 : ASSERT_BOOL (is_op3lvalue);
3851 : 1052 : ASSERT_BOOL (is_op1const);
3852 : 1052 : ASSERT_BOOL (is_op2const);
3853 : 1052 : ASSERT_BOOL (is_op3const);
3854 : 1052 : if (m2expr_CompareTrees (
3855 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
3856 : : <= 0)
3857 : : /* Small set size <= TSIZE(WORD). */
3858 : 914 : m2statement_BuildAssignmentTree (
3859 : : location, m2treelib_get_rvalue (location, op1, type, is_op1lvalue),
3860 : : (*binop) (
3861 : : location, m2treelib_get_rvalue (location, op2, type, is_op2lvalue),
3862 : : m2treelib_get_rvalue (location, op3, type, is_op3lvalue), false));
3863 : : else
3864 : : {
3865 : : /* Large set size > TSIZE(WORD). */
3866 : :
3867 : 138 : tree p2 = m2treelib_get_set_address_if_var (location, op2, is_op2lvalue,
3868 : : is_op2const);
3869 : 138 : tree p3 = m2treelib_get_set_address_if_var (location, op3, is_op3lvalue,
3870 : : is_op3const);
3871 : 138 : unsigned int fieldNo = 0;
3872 : 138 : tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
3873 : 138 : tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
3874 : 138 : tree field3 = m2treelib_get_field_no (type, op3, is_op3const, fieldNo);
3875 : :
3876 : 138 : if (is_op1const)
3877 : 0 : m2linemap_internal_error_at (
3878 : : location,
3879 : : "not expecting operand1 to be a constant set");
3880 : :
3881 : 882 : while (field1 != NULL && field2 != NULL && field3 != NULL)
3882 : : {
3883 : 744 : m2statement_BuildAssignmentTree (
3884 : : location, m2treelib_get_set_field_des (location, op1, field1),
3885 : : (*binop) (
3886 : : location,
3887 : : m2treelib_get_set_value (location, p2, field2, is_op2const,
3888 : : is_op2lvalue, op2, fieldNo),
3889 : : m2treelib_get_set_value (location, p3, field3, is_op3const,
3890 : : is_op3lvalue, op3, fieldNo),
3891 : : false));
3892 : 744 : fieldNo++;
3893 : 744 : field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
3894 : 744 : field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
3895 : 744 : field3 = m2treelib_get_field_no (type, op3, is_op3const, fieldNo);
3896 : : }
3897 : : }
3898 : 1052 : }
3899 : :
3900 : :
3901 : : /* OverflowZType returns true if the ZTYPE str will exceed the
3902 : : internal representation. This routine is much faster (at
3903 : : least 2 orders of magnitude faster) than the char at a time overflow
3904 : : detection used in ToWideInt and so it should be
3905 : : used to filter out erroneously large constants before calling ToWideInt
3906 : : allowing a quick fail. */
3907 : :
3908 : : bool
3909 : 1359239 : m2expr_OverflowZType (location_t location, const char *str, unsigned int base,
3910 : : bool issueError)
3911 : : {
3912 : 1359239 : int length = strlen (str);
3913 : 1359239 : bool overflow = false;
3914 : :
3915 : 1359239 : switch (base)
3916 : : {
3917 : 72 : case 2:
3918 : 72 : overflow = ((length -1) > WIDE_INT_MAX_PRECISION);
3919 : 72 : break;
3920 : 242162 : case 8:
3921 : 242162 : overflow = (((length -1) * 3) > WIDE_INT_MAX_PRECISION);
3922 : 242162 : break;
3923 : 1114875 : case 10:
3924 : 1114875 : {
3925 : 1114875 : int str_log10 = length;
3926 : 1114875 : int bits_str = (int) (((float) (str_log10)) / log10f (2.0)) + 1;
3927 : 1114875 : overflow = (bits_str > WIDE_INT_MAX_PRECISION);
3928 : : }
3929 : 1114875 : break;
3930 : 2130 : case 16:
3931 : 2130 : overflow = (((length -1) * 4) > WIDE_INT_MAX_PRECISION);
3932 : 2130 : break;
3933 : 0 : default:
3934 : 0 : gcc_unreachable ();
3935 : : }
3936 : 1359239 : if (issueError && overflow)
3937 : 6 : error_at (location,
3938 : : "constant literal %qs exceeds internal ZTYPE range", str);
3939 : 1359239 : return overflow;
3940 : : }
3941 : :
3942 : :
3943 : : /* ToWideInt converts a ZTYPE str value into result. */
3944 : :
3945 : : static
3946 : : bool
3947 : 537105 : ToWideInt (location_t location, const char *str, unsigned int base,
3948 : : widest_int &result, bool issueError)
3949 : : {
3950 : 537105 : tree type = m2type_GetM2ZType ();
3951 : 537105 : unsigned int i = 0;
3952 : 537105 : wi::overflow_type overflow = wi::OVF_NONE;
3953 : 537105 : widest_int wbase = wi::to_widest (m2decl_BuildIntegerConstant (base));
3954 : 537105 : unsigned int digit = 0;
3955 : 537105 : result = wi::to_widest (m2decl_BuildIntegerConstant (0));
3956 : 537105 : bool base_specifier = false;
3957 : :
3958 : 1483969 : while (((str[i] != (char)0) && (overflow == wi::OVF_NONE))
3959 : 2430833 : && (! base_specifier))
3960 : : {
3961 : 946864 : char ch = str[i];
3962 : :
3963 : 946864 : switch (base)
3964 : : {
3965 : : /* GNU m2 extension allows 'A' to represent binary literals. */
3966 : 156 : case 2:
3967 : 156 : if (ch == 'A')
3968 : : base_specifier = true;
3969 : 156 : else if ((ch < '0') || (ch > '1'))
3970 : : {
3971 : 0 : if (issueError)
3972 : 0 : error_at (location,
3973 : : "constant literal %qs contains %qc, expected 0 or 1",
3974 : : str, ch);
3975 : 0 : return true;
3976 : : }
3977 : : else
3978 : 156 : digit = (unsigned int) (ch - '0');
3979 : : break;
3980 : 355903 : case 8:
3981 : : /* An extension of 'B' indicates octal ZTYPE and 'C' octal character. */
3982 : 355903 : if ((ch == 'B') || (ch == 'C'))
3983 : : base_specifier = true;
3984 : 355903 : else if ((ch < '0') || (ch > '7'))
3985 : : {
3986 : 0 : if (issueError)
3987 : 0 : error_at (location,
3988 : : "constant literal %qs contains %qc, expected %qs",
3989 : : str, ch, "0..7");
3990 : 0 : return true;
3991 : : }
3992 : : else
3993 : 355903 : digit = (unsigned int) (ch - '0');
3994 : : break;
3995 : 587459 : case 10:
3996 : 587459 : if ((ch < '0') || (ch > '9'))
3997 : : {
3998 : 0 : if (issueError)
3999 : 0 : error_at (location,
4000 : : "constant literal %qs contains %qc, expected %qs",
4001 : : str, ch, "0..9");
4002 : 0 : return true;
4003 : : }
4004 : : else
4005 : 587459 : digit = (unsigned int) (ch - '0');
4006 : 587459 : break;
4007 : 3346 : case 16:
4008 : : /* An extension of 'H' indicates hexidecimal ZTYPE. */
4009 : 3346 : if (ch == 'H')
4010 : : base_specifier = true;
4011 : 3346 : else if ((ch >= '0') && (ch <= '9'))
4012 : 2492 : digit = (unsigned int) (ch - '0');
4013 : 854 : else if ((ch >= 'A') && (ch <= 'F'))
4014 : 854 : digit = ((unsigned int) (ch - 'A')) + 10;
4015 : : else
4016 : : {
4017 : 0 : if (issueError)
4018 : 0 : error_at (location,
4019 : : "constant literal %qs contains %qc, expected %qs or %qs",
4020 : : str, ch, "0..9", "A..F");
4021 : 0 : return true;
4022 : : }
4023 : : break;
4024 : 0 : default:
4025 : 0 : gcc_unreachable ();
4026 : : }
4027 : :
4028 : 946864 : if (! base_specifier)
4029 : : {
4030 : 946864 : widest_int wdigit = wi::to_widest (m2decl_BuildIntegerConstant (digit));
4031 : 946864 : result = wi::umul (result, wbase, &overflow);
4032 : 946864 : if (overflow == wi::OVF_NONE)
4033 : 946864 : result = wi::add (result, wdigit, UNSIGNED, &overflow);
4034 : 946864 : }
4035 : 946864 : i++;
4036 : : }
4037 : 537105 : if (overflow == wi::OVF_NONE)
4038 : : {
4039 : 537105 : tree value = wide_int_to_tree (type, result);
4040 : 537105 : if (m2expr_TreeOverflow (value))
4041 : : {
4042 : 0 : if (issueError)
4043 : 0 : error_at (location,
4044 : : "constant literal %qs exceeds internal ZTYPE range", str);
4045 : 0 : return true;
4046 : : }
4047 : : return false;
4048 : : }
4049 : : else
4050 : : {
4051 : 0 : if (issueError)
4052 : 0 : error_at (location,
4053 : : "constant literal %qs exceeds internal ZTYPE range", str);
4054 : 0 : return true;
4055 : : }
4056 : 537105 : }
4057 : :
4058 : :
4059 : : /* StrToWideInt return true if an overflow occurs when attempting to convert
4060 : : str to an unsigned ZTYPE the value is contained in the widest_int result.
4061 : : The value result is undefined if true is returned. */
4062 : :
4063 : : bool
4064 : 537105 : m2expr_StrToWideInt (location_t location, const char *str, unsigned int base,
4065 : : widest_int &result, bool issueError)
4066 : : {
4067 : 537105 : if (m2expr_OverflowZType (location, str, base, issueError))
4068 : : return true;
4069 : 537105 : return ToWideInt (location, str, base, result, issueError);
4070 : : }
4071 : :
4072 : :
4073 : : /* GetSizeOfInBits return the number of bits used to contain, type. */
4074 : :
4075 : : tree
4076 : 72 : m2expr_GetSizeOfInBits (tree type)
4077 : : {
4078 : 96 : enum tree_code code = TREE_CODE (type);
4079 : :
4080 : 96 : if (code == FUNCTION_TYPE)
4081 : 0 : return m2expr_GetSizeOfInBits (ptr_type_node);
4082 : :
4083 : : if (code == VOID_TYPE)
4084 : : {
4085 : 0 : error ("%qs applied to a void type", "sizeof");
4086 : 0 : return size_one_node;
4087 : : }
4088 : :
4089 : : if (code == VAR_DECL)
4090 : 0 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
4091 : :
4092 : : if (code == PARM_DECL)
4093 : 0 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
4094 : :
4095 : : if (code == TYPE_DECL)
4096 : 24 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
4097 : :
4098 : : if (code == COMPONENT_REF)
4099 : 0 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
4100 : :
4101 : : if (code == ERROR_MARK)
4102 : 0 : return size_one_node;
4103 : :
4104 : 72 : if (!COMPLETE_TYPE_P (type))
4105 : : {
4106 : 0 : error ("%qs applied to an incomplete type", "sizeof");
4107 : 0 : return size_zero_node;
4108 : : }
4109 : :
4110 : 72 : return m2decl_BuildIntegerConstant (TYPE_PRECISION (type));
4111 : : }
4112 : :
4113 : : /* GetSizeOf taken from c-typeck.cc (c_sizeof). */
4114 : :
4115 : : tree
4116 : 41412305 : m2expr_GetSizeOf (location_t location, tree type)
4117 : : {
4118 : 41440936 : enum tree_code code = TREE_CODE (type);
4119 : 41440936 : m2assert_AssertLocation (location);
4120 : :
4121 : 41440936 : if (code == FUNCTION_TYPE)
4122 : 0 : return m2expr_GetSizeOf (location, m2type_GetPointerType ());
4123 : :
4124 : : if (code == VOID_TYPE)
4125 : 0 : return size_one_node;
4126 : :
4127 : : if (code == VAR_DECL)
4128 : 1296 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4129 : :
4130 : : if (code == PARM_DECL)
4131 : 86 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4132 : :
4133 : : if (code == TYPE_DECL)
4134 : 27225 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4135 : :
4136 : : if (code == ERROR_MARK)
4137 : 42 : return size_one_node;
4138 : :
4139 : : if (code == CONSTRUCTOR)
4140 : 0 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4141 : :
4142 : : if (code == FIELD_DECL)
4143 : 0 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4144 : :
4145 : : if (code == COMPONENT_REF)
4146 : 24 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4147 : :
4148 : 41412263 : if (!COMPLETE_TYPE_P (type))
4149 : : {
4150 : 0 : error_at (location, "%qs applied to an incomplete type", "SIZE");
4151 : 0 : return size_zero_node;
4152 : : }
4153 : :
4154 : : /* Convert in case a char is more than one unit. */
4155 : 82824526 : return size_binop_loc (
4156 : 41412263 : location, CEIL_DIV_EXPR, TYPE_SIZE_UNIT (type),
4157 : 41412263 : size_int (TYPE_PRECISION (char_type_node) / BITS_PER_UNIT));
4158 : : }
4159 : :
4160 : : tree
4161 : 384418 : m2expr_GetIntegerZero (location_t location ATTRIBUTE_UNUSED)
4162 : : {
4163 : 384418 : return integer_zero_node;
4164 : : }
4165 : :
4166 : : tree
4167 : 53506 : m2expr_GetIntegerOne (location_t location ATTRIBUTE_UNUSED)
4168 : : {
4169 : 53506 : return integer_one_node;
4170 : : }
4171 : :
4172 : : tree
4173 : 51922 : m2expr_GetCardinalOne (location_t location)
4174 : : {
4175 : 51922 : return m2convert_ToCardinal (location, integer_one_node);
4176 : : }
4177 : :
4178 : : tree
4179 : 25739 : m2expr_GetCardinalZero (location_t location)
4180 : : {
4181 : 25739 : return m2convert_ToCardinal (location, integer_zero_node);
4182 : : }
4183 : :
4184 : : tree
4185 : 1568 : m2expr_GetWordZero (location_t location)
4186 : : {
4187 : 1568 : return m2convert_ToWord (location, integer_zero_node);
4188 : : }
4189 : :
4190 : : tree
4191 : 527124 : m2expr_GetWordOne (location_t location)
4192 : : {
4193 : 527124 : return m2convert_ToWord (location, integer_one_node);
4194 : : }
4195 : :
4196 : : tree
4197 : 64744 : m2expr_GetPointerZero (location_t location)
4198 : : {
4199 : 64744 : return m2convert_convertToPtr (location, integer_zero_node);
4200 : : }
4201 : :
4202 : : tree
4203 : 15885 : m2expr_GetPointerOne (location_t location)
4204 : : {
4205 : 15885 : return m2convert_convertToPtr (location, integer_one_node);
4206 : : }
4207 : :
4208 : : /* build_set_full_complement return a word size value with all bits
4209 : : set to one. */
4210 : :
4211 : : static tree
4212 : 15885 : build_set_full_complement (location_t location)
4213 : : {
4214 : 15885 : tree value = integer_zero_node;
4215 : 15885 : int i;
4216 : :
4217 : 15885 : m2assert_AssertLocation (location);
4218 : :
4219 : 540090 : for (i = 0; i < SET_WORD_SIZE; i++)
4220 : : {
4221 : 508320 : value = m2expr_BuildLogicalOr (
4222 : : location, value,
4223 : : m2expr_BuildLSL (
4224 : : location, m2expr_GetWordOne (location),
4225 : : m2convert_BuildConvert (location, m2type_GetWordType (),
4226 : : m2decl_BuildIntegerConstant (i), false),
4227 : : false),
4228 : : false);
4229 : : }
4230 : 15885 : return value;
4231 : : }
4232 : :
4233 : :
4234 : : /* GetCstInteger return the integer value of the cst tree. */
4235 : :
4236 : : int
4237 : 4872 : m2expr_GetCstInteger (tree cst)
4238 : : {
4239 : 4872 : return TREE_INT_CST_LOW (cst);
4240 : : }
4241 : :
4242 : :
4243 : : /* init initialise this module. */
4244 : :
4245 : : void
4246 : 15885 : m2expr_init (location_t location)
4247 : : {
4248 : 15885 : m2assert_AssertLocation (location);
4249 : :
4250 : 15885 : set_full_complement = build_set_full_complement (location);
4251 : 15885 : }
4252 : :
4253 : : #include "gt-m2-m2expr.h"
|
