Line data Source code
1 : /* m2expr.cc provides an interface to GCC expression trees.
2 :
3 : Copyright (C) 2012-2026 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 17804469 : m2expr_CompareTrees (tree e1, tree e2)
85 : {
86 17804469 : return tree_int_cst_compare (m2expr_FoldAndStrip (e1),
87 17804469 : m2expr_FoldAndStrip (e2));
88 : }
89 :
90 : /* FoldAndStrip return expression, t, after it has been folded (if
91 : possible). */
92 :
93 : tree
94 67979152 : m2expr_FoldAndStrip (tree t)
95 : {
96 67979152 : if (t != NULL)
97 : {
98 67979152 : t = fold (t);
99 67979152 : 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 1796448 : m2expr_StringLength (tree string)
110 : {
111 1796448 : 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 2305439 : CheckAddressToCardinal (location_t location, tree op)
126 : {
127 2305439 : if (m2type_IsAddress (TREE_TYPE (op)))
128 48556 : return m2convert_BuildConvert (location, m2type_GetCardinalAddressType (),
129 48556 : op, false);
130 : return op;
131 : }
132 :
133 : /* BuildTruthAndIf return true if a && b. Retain order left to right. */
134 :
135 : static tree
136 17588 : 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 7544 : 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 200 : 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 184 : m2expr_BuildPostInc (location_t location, tree op)
162 : {
163 184 : 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 552 : m2expr_BuildPostDec (location_t location, tree op)
171 : {
172 552 : 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 22902 : m2expr_BuildAddCheck (location_t location, tree op1, tree op2, tree lowest,
179 : tree min, tree max)
180 : {
181 22902 : tree t;
182 :
183 22902 : m2assert_AssertLocation (location);
184 :
185 22902 : op1 = m2expr_FoldAndStrip (op1);
186 22902 : op2 = m2expr_FoldAndStrip (op2);
187 :
188 22902 : op1 = CheckAddressToCardinal (location, op1);
189 22902 : op2 = CheckAddressToCardinal (location, op2);
190 :
191 22902 : t = m2expr_build_binary_op_check (location, PLUS_EXPR, op1, op2, false,
192 : lowest, min, max);
193 22902 : return m2expr_FoldAndStrip (t);
194 : }
195 :
196 : /* BuildAdd builds an addition tree. */
197 :
198 : tree
199 259802 : m2expr_BuildAdd (location_t location, tree op1, tree op2, bool needconvert)
200 : {
201 259802 : tree t;
202 :
203 259802 : m2assert_AssertLocation (location);
204 :
205 259802 : op1 = m2expr_FoldAndStrip (op1);
206 259802 : op2 = m2expr_FoldAndStrip (op2);
207 :
208 259802 : op1 = CheckAddressToCardinal (location, op1);
209 259802 : op2 = CheckAddressToCardinal (location, op2);
210 :
211 259802 : t = m2expr_build_binary_op (location, PLUS_EXPR, op1, op2, needconvert);
212 259802 : return m2expr_FoldAndStrip (t);
213 : }
214 :
215 : /* BuildSubCheck builds a subtraction tree. */
216 :
217 : tree
218 10318 : m2expr_BuildSubCheck (location_t location, tree op1, tree op2, tree lowest,
219 : tree min, tree max)
220 : {
221 10318 : tree t;
222 :
223 10318 : m2assert_AssertLocation (location);
224 :
225 10318 : op1 = m2expr_FoldAndStrip (op1);
226 10318 : op2 = m2expr_FoldAndStrip (op2);
227 :
228 10318 : op1 = CheckAddressToCardinal (location, op1);
229 10318 : op2 = CheckAddressToCardinal (location, op2);
230 :
231 10318 : t = m2expr_build_binary_op_check (location, MINUS_EXPR, op1, op2, false,
232 : lowest, min, max);
233 10318 : return m2expr_FoldAndStrip (t);
234 : }
235 :
236 : /* BuildSub builds a subtraction tree. */
237 :
238 : tree
239 718288 : m2expr_BuildSub (location_t location, tree op1, tree op2, bool needconvert)
240 : {
241 718288 : tree t;
242 :
243 718288 : m2assert_AssertLocation (location);
244 :
245 718288 : op1 = m2expr_FoldAndStrip (op1);
246 718288 : op2 = m2expr_FoldAndStrip (op2);
247 :
248 718288 : op1 = CheckAddressToCardinal (location, op1);
249 718288 : op2 = CheckAddressToCardinal (location, op2);
250 :
251 718288 : t = m2expr_build_binary_op (location, MINUS_EXPR, op1, op2, needconvert);
252 718288 : return m2expr_FoldAndStrip (t);
253 : }
254 :
255 : /* BuildDivTrunc builds a trunc division tree. */
256 :
257 : tree
258 65042 : m2expr_BuildDivTrunc (location_t location, tree op1, tree op2, bool needconvert)
259 : {
260 65042 : tree t;
261 :
262 65042 : m2assert_AssertLocation (location);
263 :
264 65042 : op1 = m2expr_FoldAndStrip (op1);
265 65042 : op2 = m2expr_FoldAndStrip (op2);
266 :
267 65042 : op1 = CheckAddressToCardinal (location, op1);
268 65042 : op2 = CheckAddressToCardinal (location, op2);
269 :
270 65042 : t = m2expr_build_binary_op (location, TRUNC_DIV_EXPR, op1, op2, needconvert);
271 65042 : 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 792 : m2expr_BuildModTrunc (location_t location, tree op1, tree op2, bool needconvert)
320 : {
321 792 : tree t;
322 :
323 792 : m2assert_AssertLocation (location);
324 :
325 792 : op1 = m2expr_FoldAndStrip (op1);
326 792 : op2 = m2expr_FoldAndStrip (op2);
327 :
328 792 : op1 = CheckAddressToCardinal (location, op1);
329 792 : op2 = CheckAddressToCardinal (location, op2);
330 :
331 792 : t = m2expr_build_binary_op (location, TRUNC_MOD_EXPR, op1, op2, needconvert);
332 792 : return m2expr_FoldAndStrip (t);
333 : }
334 :
335 : /* BuildModCeilCheck builds a ceil modulus tree. */
336 :
337 : tree
338 2084 : m2expr_BuildModCeilCheck (location_t location, tree op1, tree op2, tree lowest,
339 : tree min, tree max)
340 : {
341 2084 : tree t;
342 :
343 2084 : m2assert_AssertLocation (location);
344 :
345 2084 : op1 = m2expr_FoldAndStrip (op1);
346 2084 : op2 = m2expr_FoldAndStrip (op2);
347 :
348 2084 : op1 = CheckAddressToCardinal (location, op1);
349 2084 : op2 = CheckAddressToCardinal (location, op2);
350 :
351 2084 : t = m2expr_build_binary_op_check (location, CEIL_MOD_EXPR, op1, op2, false,
352 : lowest, min, max);
353 2084 : return m2expr_FoldAndStrip (t);
354 : }
355 :
356 : /* BuildModFloorCheck builds a trunc modulus tree. */
357 :
358 : tree
359 2084 : m2expr_BuildModFloorCheck (location_t location, tree op1, tree op2, tree lowest,
360 : tree min, tree max)
361 : {
362 2084 : tree t;
363 :
364 2084 : m2assert_AssertLocation (location);
365 :
366 2084 : op1 = m2expr_FoldAndStrip (op1);
367 2084 : op2 = m2expr_FoldAndStrip (op2);
368 :
369 2084 : op1 = CheckAddressToCardinal (location, op1);
370 2084 : op2 = CheckAddressToCardinal (location, op2);
371 :
372 2084 : t = m2expr_build_binary_op_check (location, FLOOR_MOD_EXPR, op1, op2, false,
373 : lowest, min, max);
374 2084 : return m2expr_FoldAndStrip (t);
375 : }
376 :
377 : /* BuildDivCeil builds a ceil division tree. */
378 :
379 : tree
380 4264 : m2expr_BuildDivCeil (location_t location, tree op1, tree op2, bool needconvert)
381 : {
382 4264 : tree t;
383 :
384 4264 : m2assert_AssertLocation (location);
385 :
386 4264 : op1 = m2expr_FoldAndStrip (op1);
387 4264 : op2 = m2expr_FoldAndStrip (op2);
388 :
389 4264 : op1 = CheckAddressToCardinal (location, op1);
390 4264 : op2 = CheckAddressToCardinal (location, op2);
391 :
392 4264 : t = m2expr_build_binary_op (location, CEIL_DIV_EXPR, op1, op2, needconvert);
393 4264 : return m2expr_FoldAndStrip (t);
394 : }
395 :
396 : /* BuildDivCeilCheck builds a check ceil division tree. */
397 :
398 : tree
399 1908 : m2expr_BuildDivCeilCheck (location_t location, tree op1, tree op2, tree lowest,
400 : tree min, tree max)
401 : {
402 1908 : tree t;
403 :
404 1908 : m2assert_AssertLocation (location);
405 :
406 1908 : op1 = m2expr_FoldAndStrip (op1);
407 1908 : op2 = m2expr_FoldAndStrip (op2);
408 :
409 1908 : op1 = CheckAddressToCardinal (location, op1);
410 1908 : op2 = CheckAddressToCardinal (location, op2);
411 :
412 1908 : t = m2expr_build_binary_op_check (location, CEIL_DIV_EXPR, op1, op2, false,
413 : lowest, min, max);
414 1908 : 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 7448 : m2expr_BuildDivFloor (location_t location, tree op1, tree op2, bool needconvert)
440 : {
441 7448 : tree t;
442 :
443 7448 : m2assert_AssertLocation (location);
444 :
445 7448 : op1 = m2expr_FoldAndStrip (op1);
446 7448 : op2 = m2expr_FoldAndStrip (op2);
447 :
448 7448 : op1 = CheckAddressToCardinal (location, op1);
449 7448 : op2 = CheckAddressToCardinal (location, op2);
450 :
451 7448 : t = m2expr_build_binary_op (location, FLOOR_DIV_EXPR, op1, op2, needconvert);
452 7448 : return m2expr_FoldAndStrip (t);
453 : }
454 :
455 : /* BuildDivFloorCheck builds a check floor division tree. */
456 :
457 : tree
458 1908 : m2expr_BuildDivFloorCheck (location_t location, tree op1, tree op2, tree lowest,
459 : tree min, tree max)
460 : {
461 1908 : tree t;
462 :
463 1908 : m2assert_AssertLocation (location);
464 :
465 1908 : op1 = m2expr_FoldAndStrip (op1);
466 1908 : op2 = m2expr_FoldAndStrip (op2);
467 :
468 1908 : op1 = CheckAddressToCardinal (location, op1);
469 1908 : op2 = CheckAddressToCardinal (location, op2);
470 :
471 1908 : t = m2expr_build_binary_op_check (location, FLOOR_DIV_EXPR, op1, op2, false,
472 : lowest, min, max);
473 1908 : 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 376 : m2expr_BuildRDiv (location_t location, tree op1, tree op2, bool needconvert)
481 : {
482 376 : tree t;
483 :
484 376 : m2assert_AssertLocation (location);
485 :
486 376 : op1 = m2expr_FoldAndStrip (op1);
487 376 : op2 = m2expr_FoldAndStrip (op2);
488 :
489 376 : t = m2expr_build_binary_op (location, RDIV_EXPR, op1, op2, needconvert);
490 376 : return m2expr_FoldAndStrip (t);
491 : }
492 :
493 : /* BuildModFloor builds a modulus tree. */
494 :
495 : tree
496 1122 : m2expr_BuildModFloor (location_t location, tree op1, tree op2, bool needconvert)
497 : {
498 1122 : tree t;
499 :
500 1122 : m2assert_AssertLocation (location);
501 :
502 1122 : op1 = m2expr_FoldAndStrip (op1);
503 1122 : op2 = m2expr_FoldAndStrip (op2);
504 :
505 1122 : op1 = CheckAddressToCardinal (location, op1);
506 1122 : op2 = CheckAddressToCardinal (location, op2);
507 :
508 1122 : t = m2expr_build_binary_op (location, FLOOR_MOD_EXPR, op1, op2, needconvert);
509 1122 : return m2expr_FoldAndStrip (t);
510 : }
511 :
512 : /* BuildLSL builds and returns tree (op1 << op2). */
513 :
514 : tree
515 507500 : m2expr_BuildLSL (location_t location, tree op1, tree op2, bool needconvert)
516 : {
517 507500 : tree t;
518 :
519 507500 : m2assert_AssertLocation (location);
520 :
521 507500 : op1 = m2expr_FoldAndStrip (op1);
522 507500 : op2 = m2expr_FoldAndStrip (op2);
523 :
524 507500 : t = m2expr_build_binary_op (location, LSHIFT_EXPR, op1, op2, needconvert);
525 507500 : return m2expr_FoldAndStrip (t);
526 : }
527 :
528 : /* BuildLSR builds and returns tree (op1 >> op2). */
529 :
530 : tree
531 2012 : m2expr_BuildLSR (location_t location, tree op1, tree op2, bool needconvert)
532 : {
533 2012 : tree t;
534 :
535 2012 : m2assert_AssertLocation (location);
536 :
537 2012 : op1 = m2expr_FoldAndStrip (op1);
538 2012 : op2 = m2expr_FoldAndStrip (op2);
539 :
540 2012 : t = m2expr_build_binary_op (location, RSHIFT_EXPR, op1, op2, needconvert);
541 2012 : return m2expr_FoldAndStrip (t);
542 : }
543 :
544 : /* createUniqueLabel returns a unique label which has been alloc'ed. */
545 :
546 : static char *
547 596 : createUniqueLabel (void)
548 : {
549 596 : int size, i;
550 596 : char *label;
551 :
552 596 : label_count++;
553 596 : i = label_count;
554 596 : size = strlen (".LSHIFT") + 2;
555 1300 : while (i > 0)
556 : {
557 704 : i /= 10;
558 704 : size++;
559 : }
560 596 : label = (char *)ggc_alloc_atomic (size);
561 596 : sprintf (label, ".LSHIFT%d", label_count);
562 596 : return label;
563 : }
564 :
565 : /* BuildLogicalShift builds the ISO Modula-2 SHIFT operator for a
566 : fundamental data type. */
567 :
568 : void
569 472 : m2expr_BuildLogicalShift (location_t location, tree op1, tree op2, tree op3,
570 : tree nBits ATTRIBUTE_UNUSED, bool needconvert)
571 : {
572 472 : tree res;
573 :
574 472 : m2assert_AssertLocation (location);
575 472 : op2 = m2expr_FoldAndStrip (op2);
576 472 : op3 = m2expr_FoldAndStrip (op3);
577 472 : if (TREE_CODE (op3) == INTEGER_CST)
578 : {
579 244 : op2 = m2convert_ToWord (location, op2);
580 244 : if (tree_int_cst_sgn (op3) < 0)
581 122 : res = m2expr_BuildLSR (
582 : location, op2,
583 : m2convert_ToWord (location,
584 : m2expr_BuildNegate (location, op3, needconvert)),
585 : needconvert);
586 : else
587 122 : res = m2expr_BuildLSL (location, op2, m2convert_ToWord (location, op3),
588 : needconvert);
589 244 : res = m2convert_BuildConvert (
590 244 : location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, false);
591 244 : m2statement_BuildAssignmentTree (location, op1, res);
592 : }
593 : else
594 : {
595 228 : char *labelElseName = createUniqueLabel ();
596 228 : char *labelEndName = createUniqueLabel ();
597 228 : tree is_less = m2expr_BuildLessThan (location,
598 : m2convert_ToInteger (location, op3),
599 : m2expr_GetIntegerZero (location));
600 :
601 228 : m2statement_IfExprJump (location, is_less, labelElseName);
602 228 : op2 = m2convert_ToWord (location, op2);
603 228 : op3 = m2convert_ToWord (location, op3);
604 228 : res = m2expr_BuildLSL (location, op2, op3, needconvert);
605 228 : res = m2convert_BuildConvert (
606 228 : location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, false);
607 228 : m2statement_BuildAssignmentTree (location, op1, res);
608 228 : m2statement_BuildGoto (location, labelEndName);
609 228 : m2statement_DeclareLabel (location, labelElseName);
610 228 : res = m2expr_BuildLSR (location, op2,
611 : m2expr_BuildNegate (location, op3, needconvert),
612 : needconvert);
613 228 : res = m2convert_BuildConvert (
614 228 : location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, false);
615 228 : m2statement_BuildAssignmentTree (location, op1, res);
616 228 : m2statement_DeclareLabel (location, labelEndName);
617 : }
618 472 : }
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 2386 : m2expr_BuildMask (location_t location, tree nBits, bool needconvert)
657 : {
658 2386 : tree mask = m2expr_BuildLSL (location, m2expr_GetIntegerOne (location),
659 : nBits, needconvert);
660 2386 : m2assert_AssertLocation (location);
661 2386 : return m2expr_BuildSub (location, mask, m2expr_GetIntegerOne (location),
662 2386 : 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);
728 146 : left = m2expr_BuildLSL (location, op1, op2min, needconvert);
729 146 : left = m2expr_BuildLogicalAnd (location, left, mask);
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);
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);
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);
776 50 : return m2expr_BuildLogicalOr (location, left, right);
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_IfExprJump (location, is_less, 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 : /* BuildIfBitInSetLower returns tree ((set >> bit) & 1). It converts set and bit to
823 : type word prior to the bit test. */
824 :
825 : static tree
826 1466 : BuildIfBitInSetLower (location_t location, enum tree_code code, tree set, tree bit)
827 : {
828 1466 : set = m2convert_ToWord (location, set);
829 1466 : bit = m2convert_ToWord (location, bit);
830 1466 : set = m2expr_BuildLSR (location, set, bit, false);
831 1466 : return m2expr_build_binary_op (location, code,
832 : m2expr_build_binary_op (location,
833 : BIT_AND_EXPR, set,
834 : m2expr_GetWordOne (location), false),
835 1466 : m2expr_GetWordZero (location), FALSE);
836 : }
837 :
838 : /* BuildIfInSet returns tree (bit IN set). */
839 :
840 : tree
841 304 : m2expr_BuildIfInSet (location_t location, tree set, tree bit)
842 : {
843 304 : m2assert_AssertLocation (location);
844 :
845 304 : return BuildIfBitInSetLower (location, NE_EXPR, set, bit);
846 : }
847 :
848 : /* BuildIfInSet returns tree (NOT (bit IN set)). */
849 :
850 : tree
851 1162 : m2expr_BuildIfNotInSet (location_t location, tree set, tree bit)
852 : {
853 1162 : m2assert_AssertLocation (location);
854 :
855 1162 : return BuildIfBitInSetLower (location, EQ_EXPR, set, bit);
856 : }
857 :
858 : /* Print a warning if a constant expression caused overflow in folding.
859 : Invoke this function on every expression that the language requires
860 : to be a constant expression. */
861 :
862 : void
863 65349 : m2expr_ConstantExpressionWarning (tree value)
864 : {
865 1256 : if ((TREE_CODE (value) == INTEGER_CST || TREE_CODE (value) == REAL_CST
866 674 : || TREE_CODE (value) == FIXED_CST || TREE_CODE (value) == VECTOR_CST
867 674 : || TREE_CODE (value) == COMPLEX_CST)
868 66225 : && TREE_OVERFLOW (value))
869 0 : pedwarn (input_location, OPT_Woverflow, "overflow in constant expression");
870 65349 : }
871 :
872 : /* TreeOverflow return true if the contant expression, t, has caused
873 : an overflow. No error message or warning is emitted and no
874 : modification is made to, t. */
875 :
876 : bool
877 5648380 : m2expr_TreeOverflow (tree t)
878 : {
879 5648380 : if ((TREE_CODE (t) == INTEGER_CST
880 53156 : || (TREE_CODE (t) == COMPLEX_CST
881 618 : && TREE_CODE (TREE_REALPART (t)) == INTEGER_CST))
882 5648380 : && TREE_OVERFLOW (t))
883 : return true;
884 5648368 : else if ((TREE_CODE (t) == REAL_CST
885 5647282 : || (TREE_CODE (t) == COMPLEX_CST
886 618 : && TREE_CODE (TREE_REALPART (t)) == REAL_CST))
887 5648986 : && TREE_OVERFLOW (t))
888 0 : return true;
889 : else
890 : return false;
891 : }
892 :
893 : /* RemoveOverflow if tree, t, is a constant expression it removes any
894 : overflow flag and returns, t. */
895 :
896 : tree
897 11160 : m2expr_RemoveOverflow (tree t)
898 : {
899 11160 : if (TREE_CODE (t) == INTEGER_CST
900 11160 : || (TREE_CODE (t) == COMPLEX_CST
901 0 : && TREE_CODE (TREE_REALPART (t)) == INTEGER_CST))
902 0 : TREE_OVERFLOW (t) = 0;
903 11160 : else if (TREE_CODE (t) == REAL_CST
904 11160 : || (TREE_CODE (t) == COMPLEX_CST
905 0 : && TREE_CODE (TREE_REALPART (t)) == REAL_CST))
906 0 : TREE_OVERFLOW (t) = 0;
907 11160 : return t;
908 : }
909 :
910 : /* BuildCoerce return a tree containing the expression, expr, after
911 : it has been coersed to, type. */
912 :
913 : tree
914 0 : m2expr_BuildCoerce (location_t location, tree des, tree type, tree expr)
915 : {
916 0 : tree copy = copy_node (expr);
917 0 : TREE_TYPE (copy) = type;
918 :
919 0 : m2assert_AssertLocation (location);
920 :
921 0 : return m2treelib_build_modify_expr (location, des, NOP_EXPR, copy);
922 : }
923 :
924 : /* BuildTrunc return an integer expression from a REAL or LONGREAL op1. */
925 :
926 : tree
927 0 : m2expr_BuildTrunc (tree op1)
928 : {
929 0 : return convert_to_integer (m2type_GetIntegerType (),
930 0 : m2expr_FoldAndStrip (op1));
931 : }
932 :
933 : /* checkUnaryWholeOverflow decide if we can check this unary expression. */
934 :
935 : tree
936 848 : m2expr_checkUnaryWholeOverflow (location_t location, enum tree_code code,
937 : tree arg, tree lowest, tree min, tree max)
938 : {
939 848 : if (M2Options_GetWholeValueCheck () && (min != NULL))
940 : {
941 108 : lowest = m2tree_skip_type_decl (lowest);
942 108 : arg = fold_convert_loc (location, lowest, arg);
943 :
944 108 : switch (code)
945 : {
946 108 : case NEGATE_EXPR:
947 108 : return checkWholeNegateOverflow (location, arg, lowest, min, max);
948 : default:
949 : return NULL;
950 : }
951 : }
952 : return NULL;
953 : }
954 :
955 : /* build_unary_op return a unary tree node. */
956 :
957 : tree
958 912 : m2expr_build_unary_op_check (location_t location, enum tree_code code,
959 : tree arg, tree lowest, tree min, tree max)
960 : {
961 912 : tree argtype = TREE_TYPE (arg);
962 912 : tree result;
963 912 : tree check = NULL;
964 :
965 912 : m2assert_AssertLocation (location);
966 :
967 912 : arg = m2expr_FoldAndStrip (arg);
968 :
969 912 : if ((TREE_CODE (argtype) != REAL_TYPE) && (min != NULL))
970 848 : check = m2expr_checkUnaryWholeOverflow (location, code, arg, lowest, min, max);
971 :
972 912 : result = build1 (code, argtype, arg);
973 912 : protected_set_expr_location (result, location);
974 :
975 912 : if (check != NULL)
976 108 : result = build2 (COMPOUND_EXPR, argtype, check, result);
977 :
978 912 : if (SCALAR_FLOAT_TYPE_P (argtype))
979 64 : m2expr_checkRealOverflow (location, code, result);
980 :
981 912 : return m2expr_FoldAndStrip (result);
982 : }
983 :
984 : /* build_unary_op return a unary tree node. */
985 :
986 : tree
987 24519 : m2expr_build_unary_op (location_t location, enum tree_code code, tree arg,
988 : int flag ATTRIBUTE_UNUSED)
989 : {
990 24519 : tree argtype = TREE_TYPE (arg);
991 24519 : tree result;
992 :
993 24519 : m2assert_AssertLocation (location);
994 :
995 24519 : arg = m2expr_FoldAndStrip (arg);
996 24519 : result = build1 (code, argtype, arg);
997 24519 : protected_set_expr_location (result, location);
998 :
999 24519 : return m2expr_FoldAndStrip (result);
1000 : }
1001 :
1002 : /* build_binary_op is a heavily pruned version of the one found in
1003 : c-typeck.cc. The Modula-2 expression rules are much more restricted
1004 : than C. */
1005 :
1006 : tree
1007 2411383 : build_binary_op (location_t location, enum tree_code code, tree op1, tree op2,
1008 : int convert ATTRIBUTE_UNUSED)
1009 : {
1010 2411383 : tree type1 = TREE_TYPE (op1);
1011 2411383 : tree result;
1012 :
1013 2411383 : m2assert_AssertLocation (location);
1014 :
1015 : /* Strip NON_LVALUE_EXPRs, etc., since we aren't using as an lvalue. */
1016 4832836 : STRIP_TYPE_NOPS (op1);
1017 2411901 : STRIP_TYPE_NOPS (op2);
1018 :
1019 2411383 : op1 = m2expr_FoldAndStrip (op1);
1020 2411383 : op2 = m2expr_FoldAndStrip (op2);
1021 :
1022 2411383 : result = build2 (code, type1, op1, op2);
1023 2411383 : protected_set_expr_location (result, location);
1024 :
1025 2411383 : return m2expr_FoldAndStrip (result);
1026 : }
1027 :
1028 : /* BuildLessThanZero - returns a tree containing (< value 0). It
1029 : checks the min and max value to ensure that the test can be safely
1030 : achieved and will short circuit the result otherwise. */
1031 :
1032 : tree
1033 5860 : m2expr_BuildLessThanZero (location_t location, tree value, tree type, tree min,
1034 : tree max)
1035 : {
1036 5860 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) >= 0)
1037 : /* min is greater than or equal to zero therefore value will always
1038 : be >= 0. */
1039 3452 : return m2type_GetBooleanFalse ();
1040 2408 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) == -1)
1041 : /* max is less than zero therefore value will always be < 0. */
1042 0 : return m2type_GetBooleanTrue ();
1043 : /* We now know 0 lies in the range min..max so we can safely cast
1044 : zero to type. */
1045 2408 : return m2expr_BuildLessThan (
1046 : location, value,
1047 2408 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1048 : }
1049 :
1050 : /* BuildGreaterThanZero - returns a tree containing (> value 0). It
1051 : checks the min and max value to ensure that the test can be safely
1052 : achieved and will short circuit the result otherwise. */
1053 :
1054 : tree
1055 5024 : m2expr_BuildGreaterThanZero (location_t location, tree value, tree type,
1056 : tree min, tree max)
1057 : {
1058 5024 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
1059 : /* min is greater than zero therefore value will always be > 0. */
1060 40 : return m2type_GetBooleanTrue ();
1061 4984 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) <= 0)
1062 : /* max is less than or equal to zero therefore value will always be
1063 : <= 0. */
1064 36 : return m2type_GetBooleanFalse ();
1065 : /* We now know 0 lies in the range min..max so we can safely cast
1066 : zero to type. */
1067 4948 : return m2expr_BuildGreaterThan (
1068 : location, value,
1069 4948 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1070 : }
1071 :
1072 : /* BuildEqualToZero - returns a tree containing (= value 0). It
1073 : checks the min and max value to ensure that the test can be safely
1074 : achieved and will short circuit the result otherwise. */
1075 :
1076 : tree
1077 1740 : m2expr_BuildEqualToZero (location_t location, tree value, tree type, tree min,
1078 : tree max)
1079 : {
1080 1740 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
1081 : /* min is greater than zero therefore value will always be > 0. */
1082 44 : return m2type_GetBooleanFalse ();
1083 1696 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
1084 : /* max is less than or equal to zero therefore value will always be <
1085 : 0. */
1086 0 : return m2type_GetBooleanFalse ();
1087 : /* We now know 0 lies in the range min..max so we can safely cast
1088 : zero to type. */
1089 1696 : return m2expr_BuildEqualTo (
1090 : location, value,
1091 1696 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1092 : }
1093 :
1094 : /* BuildNotEqualToZero - returns a tree containing (# value 0). It
1095 : checks the min and max value to ensure that the test can be safely
1096 : achieved and will short circuit the result otherwise. */
1097 :
1098 : tree
1099 1400 : m2expr_BuildNotEqualToZero (location_t location, tree value, tree type,
1100 : tree min, tree max)
1101 : {
1102 1400 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
1103 : /* min is greater than zero therefore value will always be true. */
1104 32 : return m2type_GetBooleanTrue ();
1105 1368 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
1106 : /* max is less than or equal to zero therefore value will always be
1107 : true. */
1108 0 : return m2type_GetBooleanTrue ();
1109 : /* We now know 0 lies in the range min..max so we can safely cast
1110 : zero to type. */
1111 1368 : return m2expr_BuildNotEqualTo (
1112 : location, value,
1113 1368 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1114 : }
1115 :
1116 :
1117 : /* BuildGreaterThanOrEqualZero - returns a tree containing (>= value 0). It
1118 : checks the min and max value to ensure that the test can be safely
1119 : achieved and will short circuit the result otherwise. */
1120 :
1121 : tree
1122 96 : m2expr_BuildGreaterThanOrEqualZero (location_t location, tree value, tree type,
1123 : tree min, tree max)
1124 : {
1125 96 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) >= 0)
1126 : /* min is greater than or equal to zero therefore value will always be >= 0. */
1127 48 : return m2type_GetBooleanTrue ();
1128 48 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
1129 : /* max is less than zero therefore value will always be < 0. */
1130 0 : return m2type_GetBooleanFalse ();
1131 : /* We now know 0 lies in the range min..max so we can safely cast
1132 : zero to type. */
1133 48 : return m2expr_BuildGreaterThan (
1134 : location, value,
1135 48 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1136 : }
1137 :
1138 :
1139 : /* BuildLessThanOrEqualZero - returns a tree containing (<= value 0). It
1140 : checks the min and max value to ensure that the test can be safely
1141 : achieved and will short circuit the result otherwise. */
1142 :
1143 : tree
1144 368 : m2expr_BuildLessThanOrEqualZero (location_t location, tree value, tree type,
1145 : tree min, tree max)
1146 : {
1147 368 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) > 0)
1148 : /* min is greater than zero therefore value will always be > 0. */
1149 8 : return m2type_GetBooleanFalse ();
1150 360 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) <= 0)
1151 : /* max is less than or equal to zero therefore value will always be <= 0. */
1152 0 : return m2type_GetBooleanTrue ();
1153 : /* We now know 0 lies in the range min..max so we can safely cast
1154 : zero to type. */
1155 360 : return m2expr_BuildLessThanOrEqual (
1156 : location, value,
1157 360 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1158 : }
1159 :
1160 :
1161 : /* get_current_function_name, return the name of the current function if
1162 : it currently exists. NULL is returned if we are not inside a function. */
1163 :
1164 : static const char *
1165 3868 : get_current_function_name (void)
1166 : {
1167 3868 : if (current_function_decl != NULL
1168 3868 : && (DECL_NAME (current_function_decl) != NULL)
1169 7736 : && (IDENTIFIER_POINTER (DECL_NAME (current_function_decl)) != NULL))
1170 3868 : return IDENTIFIER_POINTER (DECL_NAME (current_function_decl));
1171 : return NULL;
1172 : }
1173 :
1174 : /* checkWholeNegateOverflow - check to see whether -arg will overflow
1175 : an integer.
1176 :
1177 : PROCEDURE sneg (i: INTEGER) ;
1178 : BEGIN
1179 : IF i = MIN(INTEGER)
1180 : THEN
1181 : 'integer overflow'
1182 : END
1183 : END sneg ;
1184 :
1185 : general purpose subrange type, i, is currently legal, min is
1186 : MIN(type) and max is MAX(type).
1187 :
1188 : PROCEDURE sneg (i: type) ;
1189 : BEGIN
1190 : max := MAX (type) ;
1191 : min := MIN (type) ;
1192 : (* cannot overflow if i is 0 *)
1193 : IF (i#0) AND
1194 : (* will overflow if entire range is positive. *)
1195 : ((min >= 0) OR
1196 : (* will overflow if entire range is negative. *)
1197 : (max <= 0) OR
1198 : (* c7 and c8 and c9 and c10 -> c17 more units positive. *)
1199 : ((min < 0) AND (max > 0) AND ((min + max) > 0) AND (i > -min)) OR
1200 : (* c11 and c12 and c13 and c14 -> c18 more units negative. *)
1201 : ((min < 0) AND (max > 0) AND ((min + max) < 0) AND (i < -max)))
1202 : THEN
1203 : 'type overflow'
1204 : END
1205 : END sneg ; */
1206 :
1207 : static tree
1208 108 : checkWholeNegateOverflow (location_t location,
1209 : tree i, tree type, tree min,
1210 : tree max)
1211 : {
1212 108 : tree a1
1213 108 : = m2expr_BuildNotEqualToZero (location, i, type, min, max); /* i # 0. */
1214 108 : tree c1 = m2expr_BuildGreaterThanZero (location, min, type, min,
1215 : max); /* min > 0. */
1216 108 : tree c2 = m2expr_BuildEqualToZero (location, min, type, min,
1217 : max); /* min == 0. */
1218 108 : tree c4 = m2expr_BuildLessThanZero (location, max, type, min,
1219 : max); /* max < 0. */
1220 108 : tree c5 = m2expr_BuildEqualToZero (location, max, type, min,
1221 : max); /* max == 0. */
1222 108 : tree c7 = m2expr_BuildLessThanZero (location, min, type, min,
1223 : max); /* min < 0. */
1224 108 : tree c8 = m2expr_BuildGreaterThanZero (location, max, type, min,
1225 : max); /* max > 0. */
1226 108 : tree c9 = m2expr_BuildGreaterThanZero (
1227 : location, m2expr_BuildAdd (location, min, max, false), type, min,
1228 : max); /* min + max > 0. */
1229 108 : tree c10 = m2expr_BuildGreaterThan (
1230 : location, i, m2expr_BuildNegate (location, min, false)); /* i > -min. */
1231 108 : tree c11 = m2expr_BuildLessThanZero (
1232 : location, m2expr_BuildAdd (location, min, max, false), type, min,
1233 : max); /* min + max < 0. */
1234 108 : tree c12 = m2expr_BuildLessThan (
1235 : location, i, m2expr_BuildNegate (location, max, false)); /* i < -max. */
1236 :
1237 108 : tree b1 = m2expr_BuildTruthOrIf (location, c1, c2);
1238 108 : tree b2 = m2expr_BuildTruthOrIf (location, c8, c5);
1239 108 : tree o1 = m2expr_BuildTruthAndIf (location, b1, b2);
1240 :
1241 108 : tree b3 = m2expr_BuildTruthOrIf (location, c7, c2);
1242 108 : tree b4 = m2expr_BuildTruthOrIf (location, c4, c5);
1243 108 : tree o2 = m2expr_BuildTruthAndIf (location, b3, b4);
1244 :
1245 108 : tree o3 = m2expr_Build4TruthAndIf (location, c7, c8, c9, c10);
1246 108 : tree o4 = m2expr_Build4TruthAndIf (location, c7, c8, c11, c12);
1247 :
1248 108 : tree a2 = m2expr_Build4TruthOrIf (location, o1, o2, o3, o4);
1249 108 : tree condition
1250 108 : = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, a1, a2));
1251 :
1252 108 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1253 : get_current_function_name (),
1254 : "whole value unary minus will cause range overflow");
1255 108 : return t;
1256 : }
1257 :
1258 : /* checkWholeAddOverflow - check to see whether op1 + op2 will
1259 : overflow an integer.
1260 :
1261 : PROCEDURE sadd (i, j: INTEGER) ;
1262 : BEGIN
1263 : IF ((j>0) AND (i > MAX(INTEGER)-j)) OR ((j<0) AND (i < MIN(INTEGER)-j))
1264 : THEN
1265 : 'signed addition overflow'
1266 : END
1267 : END sadd. */
1268 :
1269 : static tree
1270 1504 : checkWholeAddOverflow (location_t location, tree i, tree j, tree lowest,
1271 : tree min, tree max)
1272 : {
1273 1504 : tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1274 1504 : tree i_gt_max_sub_j = m2expr_BuildGreaterThan (
1275 : location, i, m2expr_BuildSub (location, max, j, false));
1276 1504 : tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1277 1504 : tree i_lt_min_sub_j = m2expr_BuildLessThan (location, i,
1278 : m2expr_BuildSub (location, min, j, false));
1279 1504 : tree lhs_or = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, j_gt_zero, i_gt_max_sub_j));
1280 1504 : tree rhs_or = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, j_lt_zero, i_lt_min_sub_j));
1281 1504 : tree condition
1282 1504 : = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, lhs_or, rhs_or));
1283 1504 : tree result = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1284 : get_current_function_name (),
1285 : "whole value addition will cause a range overflow");
1286 1504 : return result;
1287 : }
1288 :
1289 : /* checkWholeSubOverflow - check to see whether op1 - op2 will
1290 : overflow an integer.
1291 :
1292 : PROCEDURE ssub (i, j: INTEGER) ;
1293 : BEGIN
1294 : IF ((j>0) AND (i < MIN(INTEGER)+j)) OR ((j<0) AND (i > MAX(INTEGER)+j))
1295 : THEN
1296 : 'signed subtraction overflow'
1297 : END
1298 : END ssub. */
1299 :
1300 : static tree
1301 956 : checkWholeSubOverflow (location_t location, tree i, tree j, tree lowest,
1302 : tree min, tree max)
1303 : {
1304 956 : tree c1 = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1305 956 : tree c2 = m2expr_BuildLessThan (location, i,
1306 : m2expr_BuildAdd (location, min, j, false));
1307 956 : tree c3 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1308 956 : tree c4 = m2expr_BuildGreaterThan (location, i,
1309 : m2expr_BuildAdd (location, max, j, false));
1310 956 : tree c5 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, c1, c2));
1311 956 : tree c6 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, c3, c4));
1312 956 : tree condition
1313 956 : = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, c5, c6));
1314 956 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1315 : get_current_function_name (),
1316 : "whole value subtraction will cause a range overflow");
1317 956 : return t;
1318 : }
1319 :
1320 : /* Build4TruthAndIf - return true if a && b && c && d. Retain order left to
1321 : * right. */
1322 :
1323 : static tree
1324 312 : m2expr_Build4TruthAndIf (location_t location, tree a, tree b, tree c, tree d)
1325 : {
1326 312 : tree t1 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, a, b));
1327 312 : tree t2 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t1, c));
1328 312 : return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t2, d));
1329 : }
1330 :
1331 : /* Build3TruthAndIf - return true if a && b && c. Retain order left to right.
1332 : */
1333 :
1334 : static tree
1335 4420 : m2expr_Build3TruthAndIf (location_t location, tree op1, tree op2, tree op3)
1336 : {
1337 4420 : tree t = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, op1, op2));
1338 4420 : return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t, op3));
1339 : }
1340 :
1341 : /* Build3TruthOrIf - return true if a || b || c. Retain order left to right.
1342 : */
1343 :
1344 : static tree
1345 188 : m2expr_Build3TruthOrIf (location_t location, tree op1, tree op2, tree op3)
1346 : {
1347 188 : tree t = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, op1, op2));
1348 188 : return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t, op3));
1349 : }
1350 :
1351 : /* Build4TruthOrIf - return true if op1 || op2 || op3 || op4. Retain order
1352 : left to right. */
1353 :
1354 : static tree
1355 1092 : m2expr_Build4TruthOrIf (location_t location, tree op1, tree op2, tree op3,
1356 : tree op4)
1357 : {
1358 1092 : tree t1 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, op1, op2));
1359 1092 : tree t2 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t1, op3));
1360 1092 : return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t2, op4));
1361 : }
1362 :
1363 : /* Build4LogicalOr - return true if op1 || op2 || op3 || op4. */
1364 :
1365 : static tree
1366 736 : m2expr_Build4LogicalOr (location_t location, tree op1, tree op2, tree op3,
1367 : tree op4)
1368 : {
1369 736 : tree t1 = m2expr_FoldAndStrip (
1370 : m2expr_BuildLogicalOr (location, op1, op2));
1371 736 : tree t2
1372 736 : = m2expr_FoldAndStrip (m2expr_BuildLogicalOr (location, t1, op3));
1373 736 : return m2expr_FoldAndStrip (
1374 736 : m2expr_BuildLogicalOr (location, t2, op4));
1375 : }
1376 :
1377 : /* checkWholeMultOverflow - check to see whether i * j will overflow
1378 : an integer.
1379 :
1380 : PROCEDURE smult (lhs, rhs: INTEGER) ;
1381 : BEGIN
1382 : IF ((lhs > 0) AND (rhs > 0) AND (lhs > max DIV rhs)) OR
1383 : ((lhs > 0) AND (rhs < 0) AND (rhs < min DIV lhs)) OR
1384 : ((lhs < 0) AND (rhs > 0) AND (lhs < min DIV rhs)) OR
1385 : ((lhs < 0) AND (rhs < 0) AND (lhs < max DIV rhs))
1386 : THEN
1387 : error ('signed multiplication overflow')
1388 : END
1389 : END smult ;
1390 :
1391 : if ((c1 && c3 && c4)
1392 : || (c1 && c5 && c6)
1393 : || (c2 && c3 && c7)
1394 : || (c2 && c5 && c8))
1395 : error ('signed subtraction overflow'). */
1396 :
1397 : static tree
1398 736 : testWholeMultOverflow (location_t location, tree lhs, tree rhs,
1399 : tree lowest, tree min, tree max)
1400 : {
1401 736 : tree c1 = m2expr_BuildGreaterThanZero (location, lhs, lowest, min, max);
1402 736 : tree c2 = m2expr_BuildLessThanZero (location, lhs, lowest, min, max);
1403 :
1404 736 : tree c3 = m2expr_BuildGreaterThanZero (location, rhs, lowest, min, max);
1405 736 : tree c4 = m2expr_BuildGreaterThan (
1406 : location, lhs, m2expr_BuildDivTrunc (location, max, rhs, false));
1407 :
1408 736 : tree c5 = m2expr_BuildLessThanZero (location, rhs, lowest, min, max);
1409 736 : tree c6 = m2expr_BuildLessThan (
1410 : location, rhs, m2expr_BuildDivTrunc (location, min, lhs, false));
1411 736 : tree c7 = m2expr_BuildLessThan (
1412 : location, lhs, m2expr_BuildDivTrunc (location, min, rhs, false));
1413 736 : tree c8 = m2expr_BuildLessThan (
1414 : location, lhs, m2expr_BuildDivTrunc (location, max, rhs, false));
1415 :
1416 736 : tree c9 = m2expr_Build3TruthAndIf (location, c1, c3, c4);
1417 736 : tree c10 = m2expr_Build3TruthAndIf (location, c1, c5, c6);
1418 736 : tree c11 = m2expr_Build3TruthAndIf (location, c2, c3, c7);
1419 736 : tree c12 = m2expr_Build3TruthAndIf (location, c2, c5, c8);
1420 :
1421 736 : tree condition = m2expr_Build4LogicalOr (location, c9, c10, c11, c12);
1422 736 : return condition;
1423 : }
1424 :
1425 :
1426 : static tree
1427 672 : checkWholeMultOverflow (location_t location, tree i, tree j, tree lowest,
1428 : tree min, tree max)
1429 : {
1430 672 : tree condition = testWholeMultOverflow (location, i, j, lowest, min, max);
1431 672 : tree result = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1432 : get_current_function_name (),
1433 : "whole value multiplication will cause a range overflow");
1434 672 : return result;
1435 : }
1436 :
1437 :
1438 : static tree
1439 32 : divMinUnderflow (location_t location, tree value, tree lowest, tree min, tree max)
1440 : {
1441 32 : tree min2 = m2expr_BuildMult (location, min, min, false);
1442 32 : tree rhs = m2expr_BuildGreaterThanOrEqual (location, value, min2);
1443 32 : tree lhs = testWholeMultOverflow (location, min, min, lowest, min, max);
1444 32 : return m2expr_BuildTruthAndIf (location, lhs, rhs);
1445 : }
1446 :
1447 : /*
1448 : divexpr - returns true if a DIV_TRUNC b will overflow.
1449 : */
1450 :
1451 : /* checkWholeDivOverflow - check to see whether i DIV_TRUNC j will overflow
1452 : an integer. The Modula-2 implementation of the GCC trees follows:
1453 :
1454 : PROCEDURE divtruncexpr (a, b: INTEGER) : BOOLEAN ;
1455 : BEGIN
1456 : (* Firstly catch division by 0. *)
1457 : RETURN ((b = 0) OR
1458 : (* Case 2 range is always negative. *)
1459 : (* In which case a division will be illegal as result will be positive. *)
1460 : (max < 0) OR
1461 : (* Case 1 both min / max are positive, check for underflow. *)
1462 : ((min >= 0) AND (max >= 0) AND (multMinOverflow (b) OR (a < b * min))) OR
1463 : (* Case 1 both min / max are positive, check for overflow. *)
1464 : ((min >= 0) AND (max >= 0) AND (divMinUnderflow (a) OR (b > a DIV min))) OR
1465 : (* Case 3 mixed range, need to check underflow. *)
1466 : ((min < 0) AND (max >= 0) AND (a < 0) AND (b < 0) AND (b >= a DIV min)) OR
1467 : ((min < 0) AND (max >= 0) AND (a < 0) AND (b > 0) AND (b <= a DIV max)) OR
1468 : ((min < 0) AND (max >= 0) AND (a >= 0) AND (b < 0) AND (a DIV b < min)))
1469 : END divtruncexpr ;
1470 :
1471 : s1 -> a DIV min
1472 : s2 -> a DIV max
1473 : s3 -> a DIV b
1474 :
1475 : b4 -> (min >= 0) AND (max >= 0)
1476 : b5 -> (min < 0) AND (max >= 0)
1477 : a_lt_b_mult_min -> (a < b * min)
1478 : b_mult_min_overflow -> testWholeMultOverflow (location, b, min, lowest, min, max)
1479 : b6 -> (b_mult_min_overflow OR a_lt_b_mult_min)
1480 : b_gt_s1 -> (b > s1)
1481 : a_div_min_overflow -> divMinUnderflow (location, a, min, lowest, min, max)
1482 : b7 -> (a_div_min_overflow OR b_gt_s1)
1483 : b8 -> (a < 0)
1484 : b9 -> (b < 0)
1485 : b10 -> (b > 0)
1486 : b11 -> (b >= s1)
1487 : b12 -> (b <= s2)
1488 : b13 -> (s3 < min)
1489 : b14 -> a >= 0
1490 :
1491 : c1 -> (b = 0)
1492 : c2 -> (max < 0)
1493 : c3 -> (b4 AND b6)
1494 : c4 -> (b4 AND b7)
1495 : c5 -> (b5 AND b8 AND b9 AND b11)
1496 : c6 -> (b5 AND b8 AND b10 AND b12)
1497 : c7 -> (b5 AND b14 AND b9 AND b13)
1498 :
1499 : if (c1 || c2 || c3 || c4 || c5 || c6 || c7)
1500 : error ('signed div trunc overflow'). */
1501 :
1502 : static tree
1503 32 : checkWholeDivTruncOverflow (location_t location, tree i, tree j, tree lowest,
1504 : tree min, tree max)
1505 : {
1506 32 : tree b4a = m2expr_BuildGreaterThanOrEqualZero (location, min, lowest, min, max);
1507 32 : tree b4b = m2expr_BuildGreaterThanOrEqualZero (location, max, lowest, min, max);
1508 32 : tree b4 = m2expr_BuildTruthAndIf (location, b4a, b4b);
1509 32 : tree b5a = m2expr_BuildLessThanZero (location, min, lowest, min, max);
1510 32 : tree b5 = m2expr_BuildTruthAndIf (location, b5a, b4b);
1511 32 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
1512 32 : tree c2 = m2expr_BuildLessThanZero (location, max, lowest, min, max);
1513 32 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, m2expr_BuildMult (location, j, min, false));
1514 32 : tree j_mult_min_overflow = testWholeMultOverflow (location, j, min, lowest, min, max);
1515 32 : tree b6 = m2expr_BuildTruthOrIf (location, j_mult_min_overflow, i_lt_j_mult_min);
1516 32 : tree c3 = m2expr_BuildTruthAndIf (location, b4, b6);
1517 32 : tree s1 = m2expr_BuildDivTrunc (location, i, min, false);
1518 32 : tree s2 = m2expr_BuildDivTrunc (location, i, max, false);
1519 32 : tree s3 = m2expr_BuildDivTrunc (location, i, j, false);
1520 :
1521 32 : tree j_gt_s1 = m2expr_BuildGreaterThan (location, j, s1);
1522 32 : tree i_div_min_overflow = divMinUnderflow (location, i, lowest, min, max);
1523 32 : tree b7 = m2expr_BuildTruthOrIf (location, i_div_min_overflow, j_gt_s1);
1524 32 : tree c4 = m2expr_BuildTruthAndIf (location, b4, b7);
1525 32 : tree b8 = m2expr_BuildLessThanZero (location, i, lowest, min, max);
1526 32 : tree b9 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1527 32 : tree b10 = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1528 32 : tree b11 = m2expr_BuildGreaterThanOrEqual (location, j, s1);
1529 32 : tree b12 = m2expr_BuildLessThanOrEqual (location, j, s2);
1530 32 : tree b13 = m2expr_BuildLessThan (location, s3, min);
1531 32 : tree b14 = m2expr_BuildGreaterThanOrEqualZero (location, i, lowest, min, max);
1532 32 : tree c5 = m2expr_Build4TruthAndIf (location, b5, b8, b9, b11);
1533 32 : tree c6 = m2expr_Build4TruthAndIf (location, b5, b8, b10, b12);
1534 32 : tree c7 = m2expr_Build4TruthAndIf (location, b5, b14, b9, b13);
1535 32 : tree c8 = m2expr_Build4TruthOrIf (location, c1, c2, c3, c4);
1536 32 : tree condition = m2expr_Build4TruthOrIf (location, c5, c6, c7, c8);
1537 32 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1538 : get_current_function_name (),
1539 : "whole value truncated division will cause a range overflow");
1540 32 : return t;
1541 : }
1542 :
1543 : #if 0
1544 : (*
1545 : divexpr - returns true if a DIV_CEIL b will overflow.
1546 : *)
1547 :
1548 : (* checkWholeDivCeilOverflow - check to see whether i DIV_CEIL j will overflow
1549 : an integer. *)
1550 :
1551 : PROCEDURE divceilexpr (i, j: INTEGER) : BOOLEAN ;
1552 : BEGIN
1553 : RETURN ((j = 0) OR (* division by zero. *)
1554 : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
1555 : therefore error. *)
1556 : ((i # 0) AND (* first operand is legally zero,
1557 : result is also legally zero. *)
1558 : divCeilOverflowCases (i, j)))
1559 : END divceilexpr ;
1560 :
1561 :
1562 : (*
1563 : divCeilOverflowCases - precondition: i, j are in range values.
1564 : postcondition: true is returned if i divceil will
1565 : result in an overflow/underflow.
1566 : *)
1567 :
1568 : PROCEDURE divCeilOverflowCases (i, j: INTEGER) : BOOLEAN ;
1569 : BEGIN
1570 : RETURN (((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j)) OR
1571 : ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j)) OR
1572 : ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j)) OR
1573 : ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j)))
1574 : END divCeilOverflowCases ;
1575 :
1576 :
1577 : (*
1578 : divCeilOverflowPosPos - precondition: i, j are legal and are both >= 0.
1579 : postcondition: true is returned if i divceil will
1580 : result in an overflow/underflow.
1581 : *)
1582 :
1583 : PROCEDURE divCeilOverflowPosPos (i, j: INTEGER) : BOOLEAN ;
1584 : BEGIN
1585 : RETURN (((i MOD j = 0) AND (i < j * minT)) OR
1586 : (((i MOD j # 0) AND (i < j * minT + 1))))
1587 : END divCeilOverflowPosPos ;
1588 :
1589 :
1590 : (*
1591 : divCeilOverflowNegNeg - precondition: i, j are in range values and both < 0.
1592 : postcondition: true is returned if i divceil will
1593 : result in an overflow/underflow.
1594 : *)
1595 :
1596 : PROCEDURE divCeilOverflowNegNeg (i, j: INTEGER) : BOOLEAN ;
1597 : BEGIN
1598 : RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
1599 : (* check for underflow. *)
1600 : ((ABS (i) MOD ABS (j) = 0) AND (i >= j * minT)) OR
1601 : ((ABS (i) MOD ABS (j) # 0) AND (i >= j * minT - 1)) OR
1602 : (* check for overflow. *)
1603 : (((ABS (i) MOD maxT) = 0) AND (ABS (i) DIV maxT > ABS (j))) OR
1604 : (((ABS (i) MOD maxT) # 0) AND (ABS (i) DIV maxT > ABS (j) + 1)))
1605 : END divCeilOverflowNegNeg ;
1606 :
1607 :
1608 : (*
1609 : divCeilOverflowNegPos - precondition: i, j are in range values. i < 0, j >= 0.
1610 : postcondition: true is returned if i divceil will
1611 : result in an overflow/underflow.
1612 : *)
1613 :
1614 : PROCEDURE divCeilOverflowNegPos (i, j: INTEGER) : BOOLEAN ;
1615 : BEGIN
1616 : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
1617 : We know the result will be negative and therefore we only need to test
1618 : against minT. *)
1619 : RETURN (((ABS (i) MOD j = 0) AND (i < j * minT)) OR
1620 : ((ABS (i) MOD j # 0) AND (i < j * minT - 1)))
1621 : END divCeilOverflowNegPos ;
1622 :
1623 :
1624 : (*
1625 : divCeilOverflowPosNeg - precondition: i, j are in range values. i >= 0, j < 0.
1626 : postcondition: true is returned if i divceil will
1627 : result in an overflow/underflow.
1628 : *)
1629 :
1630 : PROCEDURE divCeilOverflowPosNeg (i, j: INTEGER) : BOOLEAN ;
1631 : BEGIN
1632 : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
1633 : We know the result will be negative and therefore we only need to test
1634 : against minT. *)
1635 : RETURN (((i MOD ABS (j) = 0) AND (i > j * minT)) OR
1636 : ((i MOD ABS (j) # 0) AND (i > j * minT - 1)))
1637 : END divCeilOverflowPosNeg ;
1638 : #endif
1639 :
1640 : /* divCeilOverflowPosPos, precondition: lhs, rhs are legal and are both >= 0.
1641 : Postcondition: TRUE is returned if lhs divceil rhs will result
1642 : in an overflow/underflow.
1643 :
1644 : A handbuilt expression of trees implementing:
1645 :
1646 : RETURN (((lhs MOD rhs = 0) AND (min >= 0) AND (lhs < rhs * min)) OR (* check for underflow, no remainder. *)
1647 : lhs_lt_rhs_mult_min
1648 : (((lhs MOD rhs # 0) AND (lhs < rhs * min + 1)))) (* check for underflow with remainder. *)
1649 : ((lhs > min) AND (lhs - 1 > rhs * min))
1650 : lhs_gt_rhs_mult_min
1651 :
1652 : a -> (lhs MOD rhs = 0) AND (lhs < rhs * min)
1653 : b -> (lhs MOD rhs # 0) AND (lhs < rhs * min + 1)
1654 : RETURN a OR b. */
1655 :
1656 : static tree
1657 184 : divCeilOverflowPosPos (location_t location, tree i, tree j, tree lowest,
1658 : tree min, tree max)
1659 : {
1660 184 : tree i_mod_j = m2expr_BuildModTrunc (location, i, j, false);
1661 184 : tree i_mod_j_eq_zero = m2expr_BuildEqualToZero (location, i_mod_j, lowest, min, max);
1662 184 : tree i_mod_j_ne_zero = m2expr_BuildNotEqualToZero (location, i_mod_j, lowest, min, max);
1663 184 : tree j_min = m2expr_BuildMult (location, j, min, false);
1664 184 : tree j_min_1 = m2expr_BuildAdd (location, j_min, m2expr_GetIntegerOne (location), false);
1665 184 : tree i_lt_j_min = m2expr_BuildLessThan (location, i, j_min);
1666 184 : tree i_lt_j_min_1 = m2expr_BuildLessThan (location, i, j_min_1);
1667 184 : tree a = m2expr_BuildTruthAndIf (location, i_mod_j_eq_zero, i_lt_j_min);
1668 184 : tree b = m2expr_BuildTruthAndIf (location, i_mod_j_ne_zero, i_lt_j_min_1);
1669 184 : return m2expr_BuildTruthOrIf (location, a, b);
1670 : }
1671 :
1672 :
1673 : /* divCeilOverflowPosNeg precondition: i, j are in range values and i >=0, j < 0.
1674 : Postcondition: TRUE is returned if i divceil j will result in an
1675 : overflow/underflow.
1676 :
1677 : A handbuilt expression of trees implementing:
1678 :
1679 : RETURN (((i MOD ABS (j) = 0) AND (i > j * min)) OR
1680 : ((i MOD ABS (j) # 0) AND (i > j * min - 1)))
1681 :
1682 : abs_j -> (ABS (j))
1683 : i_mod_abs_j -> (i MOD abs_j)
1684 : i_mod_abs_j_eq_0 -> (i_mod_abs_j = 0)
1685 : i_mod_abs_j_ne_0 -> (i_mod_abs_j # 0)
1686 : j_mult_min -> (j * min)
1687 : j_mult_min_1 -> (j_mult_min - 1)
1688 : i_gt_j_mult_min -> (i > j_mult_min)
1689 : i_gt_j_mult_min_1 -> (i > j_mult_min_1)
1690 : a -> (i_mod_abs_j_eq_0 AND i_gt_j_mult_min)
1691 : b -> (i_mod_abs_j_ne_0 AND i_gt_j_mult_min_1)
1692 : c -> (a OR b). */
1693 :
1694 : static tree
1695 184 : divCeilOverflowPosNeg (location_t location, tree i, tree j, tree lowest, tree min, tree max)
1696 : {
1697 184 : tree abs_j = m2expr_BuildAbs (location, j);
1698 184 : tree i_mod_abs_j = m2expr_BuildModFloor (location, i, abs_j, false);
1699 184 : tree i_mod_abs_j_eq_0 = m2expr_BuildEqualToZero (location, i_mod_abs_j, lowest, min, max);
1700 184 : tree i_mod_abs_j_ne_0 = m2expr_BuildNotEqualToZero (location, i_mod_abs_j, lowest, min, max);
1701 184 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
1702 184 : tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
1703 184 : tree i_gt_j_mult_min = m2expr_BuildGreaterThan (location, i, j_mult_min);
1704 184 : tree i_gt_j_mult_min_1 = m2expr_BuildGreaterThan (location, i, j_mult_min_1);
1705 184 : tree a = m2expr_BuildTruthAndIf (location, i_mod_abs_j_eq_0, i_gt_j_mult_min);
1706 184 : tree b = m2expr_BuildTruthAndIf (location, i_mod_abs_j_ne_0, i_gt_j_mult_min_1);
1707 184 : tree c = m2expr_BuildTruthOrIf (location, a, b);
1708 184 : return c;
1709 : }
1710 :
1711 :
1712 : /* divCeilOverflowNegPos precondition: i, j are in range values and i < 0, j >= 0.
1713 : Postcondition: TRUE is returned if i divceil j will result in an
1714 : overflow/underflow.
1715 :
1716 : A handbuilt expression of trees implementing:
1717 :
1718 : RETURN (((ABS (i) MOD j = 0) AND (i < j * min)) OR
1719 : ((ABS (i) MOD j # 0) AND (i < j * min - 1)))
1720 :
1721 : abs_i -> (ABS (i))
1722 : abs_i_mod_j -> (abs_i MOD j)
1723 : abs_i_mod_j_eq_0 -> (abs_i_mod_j = 0)
1724 : abs_i_mod_j_ne_0 -> (abs_i_mod_j # 0)
1725 : j_mult_min -> (j * min)
1726 : j_mult_min_1 -> (j_mult_min - 1)
1727 : i_lt_j_mult_min -> (i < j_mult_min)
1728 : i_lt_j_mult_min_1 -> (i < j_mult_min_1)
1729 : a = (abs_i_mod_j_eq_0 AND i_lt_j_mult_min)
1730 : b = (abs_i_mod_j_ne_0 AND i_lt_j_mult_min_1)
1731 : c -> (a OR b). */
1732 :
1733 : static tree
1734 184 : divCeilOverflowNegPos (location_t location, tree i, tree j, tree lowest, tree min, tree max)
1735 : {
1736 184 : tree abs_i = m2expr_BuildAbs (location, i);
1737 184 : tree abs_i_mod_j = m2expr_BuildModFloor (location, abs_i, j, false);
1738 184 : tree abs_i_mod_j_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_j, lowest, min, max);
1739 184 : tree abs_i_mod_j_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_j, lowest, min, max);
1740 184 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
1741 184 : tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
1742 184 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
1743 184 : tree i_lt_j_mult_min_1 = m2expr_BuildLessThan (location, i, j_mult_min_1);
1744 184 : tree a = m2expr_BuildTruthAndIf (location, abs_i_mod_j_eq_0, i_lt_j_mult_min);
1745 184 : tree b = m2expr_BuildTruthAndIf (location, abs_i_mod_j_ne_0, i_lt_j_mult_min_1);
1746 184 : tree c = m2expr_BuildTruthOrIf (location, a, b);
1747 184 : return c;
1748 : }
1749 :
1750 :
1751 : /* divCeilOverflowNegNeg precondition: i, j are in range values and both < 0.
1752 : Postcondition: TRUE is returned if i divceil j will result in an
1753 : overflow/underflow.
1754 :
1755 : A handbuilt expression of trees implementing:
1756 :
1757 : RETURN ((max <= 0) OR (* signs will cause overflow. *)
1758 : (* check for underflow. *)
1759 : ((ABS (i) MOD ABS (j) = 0) AND (i >= j * min)) OR
1760 : ((ABS (i) MOD ABS (j) # 0) AND (i >= j * min - 1)) OR
1761 : (* check for overflow. *)
1762 : (((ABS (i) MOD max) = 0) AND (ABS (i) DIV max > ABS (j))) OR
1763 : (((ABS (i) MOD max) # 0) AND (ABS (i) DIV max > ABS (j) + 1)))
1764 :
1765 : max_lte_0 -> (max <= 0)
1766 : abs_i -> (ABS (i))
1767 : abs_j -> (ABS (j))
1768 : abs_i_mod_abs_j -> (abs_i MOD abs_j)
1769 : abs_i_mod_abs_j_eq_0 -> (abs_i_mod_abs_j = 0)
1770 : abs_i_mod_abs_j_ne_0 -> (abs_i_mod_abs_j # 0)
1771 : j_mult_min -> (j * min)
1772 : j_mult_min_1 -> (j_mult_min - 1)
1773 : i_ge_j_mult_min -> (i >= j_mult_min)
1774 : i_ge_j_mult_min_1 -> (i >= j_mult_min_1)
1775 : abs_i_mod_max -> (abs_i mod max)
1776 : abs_i_div_max -> (abs_i DIVfloor max)
1777 : abs_j_1 -> (abs_j + 1)
1778 : abs_i_mod_max_eq_0 -> (abs_i_mod_max = 0)
1779 : abs_i_mod_max_ne_0 -> (abs_i_mod_max # 0)
1780 : abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
1781 : abs_i_div_max_gt_abs_j_1 -> (abs_i_div_max > abs_j_1)
1782 :
1783 : a -> (abs_i_mod_abs_j_eq_0 AND i_ge_j_mult_min)
1784 : b -> (abs_i_mod_abs_j_ne_0 AND i_ge_j_mult_min_1)
1785 : c -> (abs_i_mod_max_eq_0 AND abs_i_div_max_gt_abs_j)
1786 : d -> (abs_i_mod_max_ne_0 AND abs_i_div_max_gt_abs_j_1)
1787 : e -> (a OR b OR c OR d)
1788 : return max_lte_0 OR e. */
1789 :
1790 : static tree
1791 184 : divCeilOverflowNegNeg (location_t location, tree i, tree j, tree lowest,
1792 : tree min, tree max)
1793 : {
1794 184 : tree max_lte_0 = m2expr_BuildLessThanOrEqualZero (location, max, lowest, min, max);
1795 184 : tree abs_i = m2expr_BuildAbs (location, i);
1796 184 : tree abs_j = m2expr_BuildAbs (location, j);
1797 184 : tree abs_i_mod_abs_j = m2expr_BuildModFloor (location, abs_i, abs_j, false);
1798 184 : tree abs_i_mod_abs_j_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_abs_j,
1799 : lowest, min, max);
1800 184 : tree abs_i_mod_abs_j_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_abs_j,
1801 : lowest, min, max);
1802 184 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
1803 184 : tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
1804 184 : tree i_ge_j_mult_min = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min);
1805 184 : tree i_ge_j_mult_min_1 = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min_1);
1806 184 : tree abs_i_mod_max = m2expr_BuildModFloor (location, abs_i, max, false);
1807 184 : tree abs_i_div_max = m2expr_BuildDivFloor (location, abs_i, max, false);
1808 184 : tree abs_j_1 = m2expr_BuildPostInc (location, abs_j);
1809 184 : tree abs_i_mod_max_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_max, lowest, min, max);
1810 184 : tree abs_i_mod_max_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_max, lowest, min, max);
1811 184 : tree abs_i_div_max_gt_abs_j = m2expr_BuildGreaterThan (location, abs_i_div_max, abs_j);
1812 184 : tree abs_i_div_max_gt_abs_j_1 = m2expr_BuildGreaterThan (location, abs_i_div_max, abs_j_1);
1813 :
1814 184 : tree a = m2expr_BuildTruthAndIf (location, abs_i_mod_abs_j_eq_0, i_ge_j_mult_min);
1815 184 : tree b = m2expr_BuildTruthAndIf (location, abs_i_mod_abs_j_ne_0, i_ge_j_mult_min_1);
1816 184 : tree c = m2expr_BuildTruthAndIf (location, abs_i_mod_max_eq_0, abs_i_div_max_gt_abs_j);
1817 184 : tree d = m2expr_BuildTruthAndIf (location, abs_i_mod_max_ne_0, abs_i_div_max_gt_abs_j_1);
1818 184 : tree e = m2expr_Build4TruthOrIf (location, a, b, c, d);
1819 184 : return m2expr_BuildTruthOrIf (location, max_lte_0, e);
1820 : }
1821 :
1822 :
1823 : /* divCeilOverflowCases, precondition: i, j are in range values.
1824 : Postcondition: TRUE is returned if i divceil will result in an
1825 : overflow/underflow.
1826 :
1827 : A handbuilt expression of trees implementing:
1828 :
1829 : RETURN (((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j)) OR
1830 : ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j)) OR
1831 : ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j)) OR
1832 : ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j)))
1833 :
1834 : a -> ((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j))
1835 : b -> ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j))
1836 : c -> ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j))
1837 : d -> ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j))
1838 :
1839 : RETURN a AND b AND c AND d. */
1840 :
1841 : static tree
1842 184 : divCeilOverflowCases (location_t location, tree i, tree j, tree lowest,
1843 : tree min, tree max)
1844 : {
1845 184 : tree i_gt_zero = m2expr_BuildGreaterThanZero (location, i, lowest, min, max);
1846 184 : tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1847 184 : tree i_lt_zero = m2expr_BuildLessThanZero (location, i, lowest, min, max);
1848 184 : tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1849 184 : tree a = m2expr_Build3TruthAndIf (location, i_gt_zero, j_gt_zero,
1850 : divCeilOverflowPosPos (location, i, j, lowest, min, max));
1851 184 : tree b = m2expr_Build3TruthAndIf (location, i_lt_zero, j_lt_zero,
1852 : divCeilOverflowNegNeg (location, i, j, lowest, min, max));
1853 184 : tree c = m2expr_Build3TruthAndIf (location, i_gt_zero, j_lt_zero,
1854 : divCeilOverflowPosNeg (location, i, j, lowest, min, max));
1855 184 : tree d = m2expr_Build3TruthAndIf (location, i_lt_zero, j_gt_zero,
1856 : divCeilOverflowNegPos (location, i, j, lowest, min, max));
1857 184 : return m2expr_Build4TruthOrIf (location, a, b, c, d);
1858 : }
1859 :
1860 :
1861 : /* checkWholeDivCeilOverflow check to see whether i DIV_CEIL j will overflow
1862 : an integer. A handbuilt expression of trees implementing:
1863 :
1864 : RETURN ((j = 0) OR (* division by zero. *)
1865 : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
1866 : therefore error. *)
1867 : ((i # 0) AND (* first operand is legally zero,
1868 : result is also legally zero. *)
1869 : divCeilOverflowCases (i, j)))
1870 :
1871 : using the following subexpressions:
1872 :
1873 : j_eq_zero -> (j == 0)
1874 : max_lt_zero -> (max < 0)
1875 : i_ne_zero -> (i # 0). */
1876 :
1877 : static tree
1878 184 : checkWholeDivCeilOverflow (location_t location, tree i, tree j, tree lowest,
1879 : tree min, tree max)
1880 : {
1881 184 : tree j_eq_zero = m2expr_BuildEqualToZero (location, j, lowest, min, max);
1882 184 : tree max_lt_zero = m2expr_BuildLessThanZero (location, max, lowest, min, max);
1883 184 : tree i_ne_zero = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
1884 184 : tree j_lt_zero;
1885 184 : tree rhs = m2expr_BuildTruthAndIf (location,
1886 : i_ne_zero,
1887 : divCeilOverflowCases (location,
1888 : i, j, lowest, min, max));
1889 :
1890 184 : if (M2Options_GetISO ())
1891 184 : j_lt_zero = m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location, j, lowest, min, max));
1892 : else
1893 0 : j_lt_zero = m2expr_GetIntegerZero (location);
1894 184 : j_eq_zero = m2expr_FoldAndStrip (j_eq_zero);
1895 184 : max_lt_zero = m2expr_FoldAndStrip (max_lt_zero);
1896 184 : i_ne_zero = m2expr_FoldAndStrip (i_ne_zero);
1897 184 : rhs = m2expr_FoldAndStrip (rhs);
1898 :
1899 184 : tree condition = m2expr_Build4TruthOrIf (location, j_eq_zero, max_lt_zero, rhs, j_lt_zero);
1900 184 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1901 : get_current_function_name (),
1902 : "whole value ceil division will cause a range overflow");
1903 184 : return t;
1904 : }
1905 :
1906 :
1907 : /* checkWholeModTruncOverflow, the GCC tree.def defines TRUNC_MOD_EXPR to return
1908 : the remainder which has the same sign as the dividend. In ISO Modula-2 the
1909 : divisor must never be negative (or zero). The pseudo code for implementing these
1910 : checks is given below:
1911 :
1912 : IF j = 0
1913 : THEN
1914 : RETURN TRUE (* division by zero. *)
1915 : ELSIF j < 0
1916 : THEN
1917 : RETURN TRUE (* modulus and division by negative (rhs) not allowed in ISO Modula-2. *)
1918 : ELSIF i = 0
1919 : THEN
1920 : RETURN FALSE (* must be legal as result is same as operand. *)
1921 : ELSIF i > 0
1922 : THEN
1923 : (* test for: i MOD j < minT *)
1924 : IF j > i
1925 : THEN
1926 : RETURN FALSE
1927 : END ;
1928 : RETURN i - ((i DIV j) * j) < minT
1929 : ELSIF i < 0
1930 : THEN
1931 : (* the result will always be positive and less than i, given that j is less than zero
1932 : we know that minT must be < 0 as well and therefore the result of i MOD j will
1933 : never underflow. *)
1934 : RETURN FALSE
1935 : END ;
1936 : RETURN FALSE
1937 :
1938 : which can be converted into a large expression:
1939 :
1940 : RETURN (j = 0) OR ((j < 0) AND ISO) OR
1941 : ((i # 0) AND (j <= i) AND (i - ((i DIVtrunc j) * j) < minT)
1942 :
1943 : and into GCC trees:
1944 :
1945 : c1 -> (j = 0)
1946 : c2 -> (j < 0) (* only called from ISO or PIM4 or -fpositive-mod-floor *)
1947 : c3 -> (i # 0)
1948 : c4 -> (j <= i)
1949 : c6 -> (i DIVtrunc j)
1950 : c7 -> (i - (c6 * j))
1951 : c5 -> c7 < minT
1952 :
1953 : t -> (c1 OR c2 OR
1954 : (c3 AND c4 AND c5)). */
1955 :
1956 : static tree
1957 4 : checkWholeModTruncOverflow (location_t location, tree i, tree j, tree lowest,
1958 : tree min, tree max)
1959 : {
1960 4 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
1961 4 : tree c2 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1962 4 : tree c3 = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
1963 4 : tree c4 = m2expr_BuildLessThanOrEqual (location, j, i);
1964 4 : tree c6 = m2expr_BuildDivTrunc (location, i, j, false);
1965 4 : tree c7 = m2expr_BuildSub (location, i, m2expr_BuildMult (location, c6, j, false), false);
1966 4 : tree c5 = m2expr_BuildLessThan (location, c7, min);
1967 4 : tree c8 = m2expr_Build3TruthAndIf (location, c3, c4, c5);
1968 4 : tree condition = m2expr_Build3TruthOrIf (location, c1, c2, c8);
1969 4 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1970 : get_current_function_name (),
1971 : "whole value trunc modulus will cause a range overflow");
1972 4 : return t;
1973 : }
1974 :
1975 :
1976 : /* checkWholeModCeilOverflow, the GCC tree.def defines CEIL_MOD_EXPR to return
1977 : the remainder which has the same opposite of the divisor. In gm2 this is
1978 : only called when the divisor is negative. The pseudo code for implementing
1979 : these checks is given below:
1980 :
1981 : IF j = 0
1982 : THEN
1983 : RETURN TRUE (* division by zero. *)
1984 : END ;
1985 : t := i - j * divceil (i, j) ;
1986 : printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
1987 : t, i, j, i, j, divceil (i, j));
1988 : RETURN NOT ((t >= minT) AND (t <= maxT))
1989 :
1990 : which can be converted into the expression:
1991 :
1992 : t := i - j * divceil (i, j) ;
1993 : RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
1994 :
1995 : and into GCC trees:
1996 :
1997 : c1 -> (j = 0)
1998 : c2 -> (i - j)
1999 : c3 -> (i DIVceil j)
2000 : t -> (c2 * c3)
2001 : c4 -> (t >= minT)
2002 : c5 -> (t <= maxT)
2003 : c6 -> (c4 AND c5)
2004 : c7 -> (NOT c6)
2005 : c8 -> (c1 OR c7)
2006 : return c8. */
2007 :
2008 : static tree
2009 100 : checkWholeModCeilOverflow (location_t location,
2010 : tree i, tree j, tree lowest,
2011 : tree min, tree max)
2012 : {
2013 100 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2014 100 : tree c2 = m2expr_BuildSub (location, i, j, false);
2015 100 : tree c3 = m2expr_BuildDivCeil (location, i, j, false);
2016 100 : tree t = m2expr_BuildMult (location, c2, c3, false);
2017 100 : tree c4 = m2expr_BuildGreaterThanOrEqual (location, t, min);
2018 100 : tree c5 = m2expr_BuildLessThanOrEqual (location, t, max);
2019 100 : tree c6 = m2expr_BuildTruthAndIf (location, c4, c5);
2020 100 : tree c7 = m2expr_BuildTruthNot (location, c6);
2021 100 : tree condition = m2expr_BuildTruthOrIf (location, c1, c7);
2022 100 : tree s = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2023 : get_current_function_name (),
2024 : "whole value ceil modulus will cause a range overflow");
2025 100 : return s;
2026 : }
2027 :
2028 :
2029 : /* checkWholeModFloorOverflow, the GCC tree.def defines FLOOR_MOD_EXPR to return
2030 : the remainder which has the same sign as the divisor. In gm2 this is
2031 : only called when the divisor is positive. The pseudo code for implementing
2032 : these checks is given below:
2033 :
2034 : IF j = 0
2035 : THEN
2036 : RETURN TRUE (* division by zero. *)
2037 : END ;
2038 : t := i - j * divfloor (i, j) ;
2039 : printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
2040 : t, i, j, i, j, divfloor (i, j));
2041 : RETURN NOT ((t >= minT) AND (t <= maxT))
2042 :
2043 : which can be converted into the expression:
2044 :
2045 : t := i - j * divfloor (i, j) ;
2046 : RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
2047 :
2048 : and into GCC trees:
2049 :
2050 : c1 -> (j = 0)
2051 : c2 -> (i - j)
2052 : c3 -> (i DIVfloor j)
2053 : t -> (c2 * c3)
2054 : c4 -> (t >= minT)
2055 : c5 -> (t <= maxT)
2056 : c6 -> (c4 AND c5)
2057 : c7 -> (NOT c6)
2058 : c8 -> (c1 OR c7)
2059 : return c8. */
2060 :
2061 : static tree
2062 100 : checkWholeModFloorOverflow (location_t location,
2063 : tree i, tree j, tree lowest,
2064 : tree min, tree max)
2065 : {
2066 100 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2067 100 : tree c2 = m2expr_BuildSub (location, i, j, false);
2068 100 : tree c3 = m2expr_BuildDivFloor (location, i, j, false);
2069 100 : tree t = m2expr_BuildMult (location, c2, c3, false);
2070 100 : tree c4 = m2expr_BuildGreaterThanOrEqual (location, t, min);
2071 100 : tree c5 = m2expr_BuildLessThanOrEqual (location, t, max);
2072 100 : tree c6 = m2expr_BuildTruthAndIf (location, c4, c5);
2073 100 : tree c7 = m2expr_BuildTruthNot (location, c6);
2074 100 : tree condition = m2expr_BuildTruthOrIf (location, c1, c7);
2075 100 : tree s = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2076 : get_current_function_name (),
2077 : "whole value floor modulus will cause a range overflow");
2078 100 : return s;
2079 : }
2080 :
2081 :
2082 : #if 0
2083 : /* The following is a Modula-2 implementation of the C tree node code
2084 : this code has been hand translated into GCC trees. */
2085 :
2086 : (*
2087 : divFloorOverflow2 - returns true if an overflow will occur
2088 : if i divfloor j is performed.
2089 : *)
2090 :
2091 : PROCEDURE divFloorOverflow (i, j: INTEGER) : BOOLEAN ;
2092 : BEGIN
2093 : RETURN ((j = 0) OR (* division by zero. *)
2094 : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
2095 : therefore error. *)
2096 : (* --fixme-- remember here to also check
2097 : if ISO M2 dialect and j < 0
2098 : which will also generate an error. *)
2099 : ((i # 0) AND (* first operand is legally zero,
2100 : result is also legally zero. *)
2101 : divFloorOverflowCases (i, j)))
2102 : END divFloorOverflow ;
2103 :
2104 :
2105 : (*
2106 : divFloorOverflowCases - precondition: i, j are in range values.
2107 : postcondition: true is returned if i divfloor will
2108 : result in an overflow/underflow.
2109 : *)
2110 :
2111 : PROCEDURE divFloorOverflowCases (i, j: INTEGER) : BOOLEAN ;
2112 : BEGIN
2113 : RETURN (((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j)) OR
2114 : ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j)) OR
2115 : ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j)) OR
2116 : ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j)))
2117 : END divFloorOverflowCases ;
2118 :
2119 :
2120 : (*
2121 : divFloorOverflowPosPos - precondition: lhs, rhs are legal and are both >= 0.
2122 : postcondition: true is returned if lhs divfloor rhs will
2123 : result in an overflow/underflow.
2124 : *)
2125 :
2126 : PROCEDURE divFloorOverflowPosPos (lhs, rhs: INTEGER) : BOOLEAN ;
2127 : BEGIN
2128 : RETURN multMinOverflow (rhs) OR (lhs < rhs * min)
2129 : END divFloorOverflowPosPos ;
2130 :
2131 :
2132 : (*
2133 : divFloorOverflowNegNeg - precondition: i, j are in range values and both < 0.
2134 : postcondition: true is returned if i divfloor will
2135 : result in an overflow/underflow.
2136 : *)
2137 :
2138 : PROCEDURE divFloorOverflowNegNeg (i, j: INTEGER) : BOOLEAN ;
2139 : BEGIN
2140 : RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
2141 : (* check for underflow. *)
2142 : (i >= j * minT) OR
2143 : (* check for overflow. *)
2144 : (ABS (i) DIV maxT > ABS (j)))
2145 : END divFloorOverflowNegNeg ;
2146 :
2147 :
2148 : (*
2149 : divFloorOverflowNegPos - precondition: i, j are in range values. i < 0, j >= 0.
2150 : postcondition: true is returned if i divfloor will
2151 : result in an overflow/underflow.
2152 : *)
2153 :
2154 : PROCEDURE divFloorOverflowNegPos (i, j: INTEGER) : BOOLEAN ;
2155 : BEGIN
2156 : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
2157 : We know the result will be negative and therefore we only need to test
2158 : against minT. *)
2159 : RETURN i < j * minT
2160 : END divFloorOverflowNegPos ;
2161 :
2162 :
2163 : (*
2164 : divFloorOverflowPosNeg - precondition: i, j are in range values. i >= 0, j < 0.
2165 : postcondition: true is returned if i divfloor will
2166 : result in an overflow/underflow.
2167 : *)
2168 :
2169 : PROCEDURE divFloorOverflowPosNeg (i, j: INTEGER) : BOOLEAN ;
2170 : BEGIN
2171 : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
2172 : We know the result will be negative and therefore we only need to test
2173 : against minT. *)
2174 : RETURN i >= j * minT - j (* is safer than i > j * minT -1 *)
2175 : END divFloorOverflowPosNeg ;
2176 : #endif
2177 :
2178 :
2179 : /* divFloorOverflowPosPos, precondition: i, j are legal and are both >= 0.
2180 : Postcondition: true is returned if i divfloor will result in an overflow/underflow.
2181 :
2182 : A handbuilt expression of trees implementing:
2183 :
2184 : RETURN i < j * min
2185 :
2186 : j_mult_min -> (j * min)
2187 : RETURN i < j_mult_min. */
2188 :
2189 : static tree
2190 184 : divFloorOverflowPosPos (location_t location, tree i, tree j, tree min)
2191 : {
2192 184 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2193 184 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
2194 184 : return i_lt_j_mult_min;
2195 : }
2196 :
2197 :
2198 : /* divFloorOverflowNegNeg precondition: i, j are in range values and both < 0.
2199 : Postcondition: true is returned if i divfloor j will result in an
2200 : overflow/underflow.
2201 :
2202 : A handbuilt expression of trees implementing:
2203 :
2204 : RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
2205 : (* check for underflow. *)
2206 : (i >= j * min) OR
2207 : (* check for overflow. *)
2208 : (ABS (i) DIV max > ABS (j)))
2209 :
2210 : max_lte_0 -> (max <= 0)
2211 : abs_i -> (ABS (i))
2212 : abs_j -> (ABS (j))
2213 : j_mult_min -> (j * min)
2214 : i_ge_j_mult_min -> (i >= j_mult_min)
2215 : abs_i_div_max -> (abs_i divfloor max)
2216 : abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
2217 :
2218 : return max_lte_0 OR
2219 : i_ge_j_mult_min OR
2220 : abs_i_div_max_gt_abs_j. */
2221 :
2222 : static tree
2223 184 : divFloorOverflowNegNeg (location_t location, tree i, tree j, tree lowest,
2224 : tree min, tree max)
2225 : {
2226 184 : tree max_lte_0 = m2expr_BuildLessThanOrEqualZero (location, max, lowest, min, max);
2227 184 : tree abs_i = m2expr_BuildAbs (location, i);
2228 184 : tree abs_j = m2expr_BuildAbs (location, j);
2229 184 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2230 184 : tree i_ge_j_mult_min = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min);
2231 184 : tree abs_i_div_max = m2expr_BuildDivFloor (location, abs_i, max, false);
2232 184 : tree abs_i_div_max_gt_abs_j = m2expr_BuildGreaterThan (location, abs_i_div_max, abs_j);
2233 :
2234 184 : return m2expr_Build3TruthOrIf (location, max_lte_0, i_ge_j_mult_min, abs_i_div_max_gt_abs_j);
2235 : }
2236 :
2237 :
2238 : /* divFloorOverflowPosNeg precondition: i, j are in range values and i >=0, j < 0.
2239 : Postcondition: true is returned if i divfloor j will result in an
2240 : overflow/underflow.
2241 :
2242 : A handbuilt expression of trees implementing:
2243 :
2244 : RETURN i >= j * min - j (* is safer than i > j * min -1 *)
2245 :
2246 : j_mult_min -> (j * min)
2247 : j_mult_min_sub_j -> (j_mult_min - j)
2248 : i_ge_j_mult_min_sub_j -> (i >= j_mult_min_sub_j)
2249 :
2250 : return i_ge_j_mult_min_sub_j. */
2251 :
2252 : static tree
2253 184 : divFloorOverflowPosNeg (location_t location, tree i, tree j, tree min)
2254 : {
2255 184 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2256 184 : tree j_mult_min_sub_j = m2expr_BuildSub (location, j_mult_min, j, false);
2257 184 : tree i_ge_j_mult_min_sub_j = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min_sub_j);
2258 184 : return i_ge_j_mult_min_sub_j;
2259 : }
2260 :
2261 :
2262 : /* divFloorOverflowNegPos precondition: i, j are in range values and i < 0, j > 0.
2263 : Postcondition: true is returned if i divfloor j will result in an
2264 : overflow/underflow.
2265 :
2266 : A handbuilt expression of trees implementing:
2267 :
2268 : RETURN i < j * min
2269 :
2270 : j_mult_min -> (j * min)
2271 : RETURN i < j_mult_min. */
2272 :
2273 : static tree
2274 184 : divFloorOverflowNegPos (location_t location, tree i, tree j, tree min)
2275 : {
2276 184 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2277 184 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
2278 184 : return i_lt_j_mult_min;
2279 : }
2280 :
2281 :
2282 : /* divFloorOverflowCases, precondition: i, j are in range values.
2283 : Postcondition: true is returned if i divfloor will result in an
2284 : overflow/underflow.
2285 :
2286 : A handbuilt expression of trees implementing:
2287 :
2288 : RETURN (((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j)) OR
2289 : ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j)) OR
2290 : ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j)) OR
2291 : ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j)))
2292 :
2293 : a -> ((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j))
2294 : b -> ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j))
2295 : c -> ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j))
2296 : d -> ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j))
2297 :
2298 : RETURN a AND b AND c AND d. */
2299 :
2300 : static tree
2301 184 : divFloorOverflowCases (location_t location, tree i, tree j, tree lowest,
2302 : tree min, tree max)
2303 : {
2304 184 : tree i_gt_zero = m2expr_BuildGreaterThanZero (location, i, lowest, min, max);
2305 184 : tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
2306 184 : tree i_lt_zero = m2expr_BuildLessThanZero (location, i, lowest, min, max);
2307 184 : tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
2308 184 : tree a = m2expr_Build3TruthAndIf (location, i_gt_zero, j_gt_zero,
2309 : divFloorOverflowPosPos (location, i, j, min));
2310 184 : tree b = m2expr_Build3TruthAndIf (location, i_lt_zero, j_lt_zero,
2311 : divFloorOverflowNegNeg (location, i, j, lowest, min, max));
2312 184 : tree c = m2expr_Build3TruthAndIf (location, i_gt_zero, j_lt_zero,
2313 : divFloorOverflowPosNeg (location, i, j, min));
2314 184 : tree d = m2expr_Build3TruthAndIf (location, i_lt_zero, j_gt_zero,
2315 : divFloorOverflowNegPos (location, i, j, min));
2316 184 : return m2expr_Build4TruthOrIf (location, a, b, c, d);
2317 : }
2318 :
2319 :
2320 : /* checkWholeDivFloorOverflow check to see whether i DIV_FLOOR j will overflow
2321 : an integer. A handbuilt expression of trees implementing:
2322 :
2323 : RETURN ((j = 0) OR (* division by zero. *)
2324 : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
2325 : therefore error. *)
2326 : (* we also check
2327 : if ISO M2 dialect and j < 0
2328 : which will also generate an error. *)
2329 : ((i # 0) AND (* first operand is legally zero,
2330 : result is also legally zero. *)
2331 : divFloorOverflowCases (i, j)))
2332 :
2333 : using the following subexpressions:
2334 :
2335 : j_eq_zero -> (j == 0)
2336 : max_lt_zero -> (max < 0)
2337 : i_ne_zero -> (i # 0). */
2338 :
2339 : static tree
2340 184 : checkWholeDivFloorOverflow (location_t location, tree i, tree j, tree lowest,
2341 : tree min, tree max)
2342 : {
2343 184 : tree j_eq_zero = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2344 184 : tree max_lt_zero = m2expr_BuildLessThanZero (location, max, lowest, min, max);
2345 184 : tree i_ne_zero = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
2346 184 : tree j_lt_zero;
2347 184 : tree rhs = m2expr_BuildTruthAndIf (location,
2348 : i_ne_zero,
2349 : divFloorOverflowCases (location,
2350 : i, j, lowest, min, max));
2351 :
2352 184 : if (M2Options_GetISO ())
2353 : /* ISO Modula-2 raises an exception if the right hand operand is < 0. */
2354 184 : j_lt_zero = m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location, j, lowest, min, max));
2355 : else
2356 0 : j_lt_zero = m2expr_GetIntegerZero (location);
2357 184 : j_eq_zero = m2expr_FoldAndStrip (j_eq_zero);
2358 184 : max_lt_zero = m2expr_FoldAndStrip (max_lt_zero);
2359 184 : i_ne_zero = m2expr_FoldAndStrip (i_ne_zero);
2360 184 : rhs = m2expr_FoldAndStrip (rhs);
2361 :
2362 184 : tree condition = m2expr_Build4TruthOrIf (location, j_eq_zero, max_lt_zero, rhs, j_lt_zero);
2363 184 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2364 : get_current_function_name (),
2365 : "whole value floor division will cause a range overflow");
2366 184 : return t;
2367 : }
2368 :
2369 : /* checkWholeOverflow check to see if the binary operators will overflow
2370 : ordinal types. */
2371 :
2372 : static tree
2373 49172 : m2expr_checkWholeOverflow (location_t location, enum tree_code code, tree op1,
2374 : tree op2, tree lowest, tree min, tree max)
2375 : {
2376 49172 : if (M2Options_GetWholeValueCheck () && (min != NULL))
2377 : {
2378 3736 : lowest = m2tree_skip_type_decl (lowest);
2379 3736 : op1 = fold_convert_loc (location, lowest, op1);
2380 3736 : op2 = fold_convert_loc (location, lowest, op2);
2381 :
2382 3736 : switch (code)
2383 : {
2384 1504 : case PLUS_EXPR:
2385 1504 : return checkWholeAddOverflow (location, op1, op2, lowest, min, max);
2386 956 : case MINUS_EXPR:
2387 956 : return checkWholeSubOverflow (location, op1, op2, lowest, min, max);
2388 672 : case MULT_EXPR:
2389 672 : return checkWholeMultOverflow (location, op1, op2, lowest, min, max);
2390 32 : case TRUNC_DIV_EXPR:
2391 32 : return checkWholeDivTruncOverflow (location, op1, op2, lowest, min, max);
2392 184 : case CEIL_DIV_EXPR:
2393 184 : return checkWholeDivCeilOverflow (location, op1, op2, lowest, min, max);
2394 184 : case FLOOR_DIV_EXPR:
2395 184 : return checkWholeDivFloorOverflow (location, op1, op2, lowest, min, max);
2396 4 : case TRUNC_MOD_EXPR:
2397 4 : return checkWholeModTruncOverflow (location, op1, op2, lowest, min, max);
2398 100 : case CEIL_MOD_EXPR:
2399 100 : return checkWholeModCeilOverflow (location, op1, op2, lowest, min, max);
2400 100 : case FLOOR_MOD_EXPR:
2401 100 : return checkWholeModFloorOverflow (location, op1, op2, lowest, min, max);
2402 : default:
2403 : return NULL;
2404 : }
2405 : }
2406 : return NULL;
2407 : }
2408 :
2409 : /* checkRealOverflow if we have enabled real value checking then
2410 : generate an overflow check appropriate to the tree code being used. */
2411 :
2412 : static void
2413 1670 : m2expr_checkRealOverflow (location_t location, enum tree_code code,
2414 : tree result)
2415 : {
2416 1670 : if (M2Options_GetFloatValueCheck ())
2417 : {
2418 72 : tree condition = m2expr_BuildEqualTo (
2419 : location, m2builtins_BuiltInIsfinite (location, result),
2420 : m2expr_GetIntegerZero (location));
2421 72 : switch (code)
2422 : {
2423 0 : case PLUS_EXPR:
2424 0 : m2type_AddStatement (location,
2425 : M2Range_BuildIfCallRealHandlerLoc (
2426 : location, condition,
2427 : get_current_function_name (),
2428 : "floating point + has caused an overflow"));
2429 0 : break;
2430 0 : case MINUS_EXPR:
2431 0 : m2type_AddStatement (location,
2432 : M2Range_BuildIfCallRealHandlerLoc (
2433 : location, condition,
2434 : get_current_function_name (),
2435 : "floating point - has caused an overflow"));
2436 0 : break;
2437 12 : case RDIV_EXPR:
2438 12 : case FLOOR_DIV_EXPR:
2439 12 : case CEIL_DIV_EXPR:
2440 12 : case TRUNC_DIV_EXPR:
2441 12 : m2type_AddStatement (location,
2442 : M2Range_BuildIfCallRealHandlerLoc (
2443 : location, condition,
2444 : get_current_function_name (),
2445 : "floating point / has caused an overflow"));
2446 12 : break;
2447 12 : case MULT_EXPR:
2448 12 : m2type_AddStatement (location,
2449 : M2Range_BuildIfCallRealHandlerLoc (
2450 : location, condition,
2451 : get_current_function_name (),
2452 : "floating point * has caused an overflow"));
2453 12 : break;
2454 0 : case NEGATE_EXPR:
2455 0 : m2type_AddStatement (
2456 : location, M2Range_BuildIfCallRealHandlerLoc (
2457 : location, condition,
2458 : get_current_function_name (),
2459 : "floating point unary - has caused an overflow"));
2460 : default:
2461 : break;
2462 : }
2463 : }
2464 1670 : }
2465 :
2466 : /* build_binary_op, a wrapper for the lower level build_binary_op
2467 : above. */
2468 :
2469 : tree
2470 2413575 : m2expr_build_binary_op_check (location_t location, enum tree_code code,
2471 : tree op1, tree op2, bool needconvert, tree lowest,
2472 : tree min, tree max)
2473 : {
2474 2413575 : tree type1, type2, result;
2475 2413575 : tree check = NULL;
2476 :
2477 2413575 : op1 = m2expr_FoldAndStrip (op1);
2478 2413575 : op2 = m2expr_FoldAndStrip (op2);
2479 :
2480 2413575 : type1 = m2tree_skip_type_decl (TREE_TYPE (op1));
2481 2413575 : type2 = m2tree_skip_type_decl (TREE_TYPE (op2));
2482 :
2483 2413575 : m2assert_AssertLocation (location);
2484 :
2485 2413575 : if (code == PLUS_EXPR)
2486 : {
2487 282704 : if (POINTER_TYPE_P (type1))
2488 : {
2489 2180 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2490 2180 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
2491 2180 : op1, op2);
2492 : }
2493 280524 : else if (POINTER_TYPE_P (type2))
2494 : {
2495 0 : op1 = fold_convert_loc (location, sizetype, unshare_expr (op1));
2496 0 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op2),
2497 0 : op2, op1);
2498 : }
2499 : }
2500 2411395 : if (code == MINUS_EXPR)
2501 : {
2502 728712 : if (POINTER_TYPE_P (type1))
2503 : {
2504 12 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2505 12 : op2 = fold_build1_loc (location, NEGATE_EXPR, sizetype, op2);
2506 12 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
2507 12 : op1, op2);
2508 : }
2509 728700 : else if (POINTER_TYPE_P (type2))
2510 : {
2511 0 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2512 0 : op2 = fold_build1_loc (location, NEGATE_EXPR, sizetype, op2);
2513 0 : op1 = fold_convert_loc (location, sizetype, unshare_expr (op1));
2514 0 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op2),
2515 0 : op2, op1);
2516 : }
2517 : }
2518 :
2519 2411383 : if ((code != LSHIFT_EXPR) && (code != RSHIFT_EXPR) && (code != LROTATE_EXPR)
2520 : && (code == RROTATE_EXPR))
2521 74 : if (type1 != type2)
2522 0 : error_at (location, "not expecting different types to binary operator");
2523 :
2524 2411383 : if ((TREE_CODE (type1) != REAL_TYPE) && (min != NULL))
2525 49172 : check = m2expr_checkWholeOverflow (location, code, op1, op2, lowest, min, max);
2526 :
2527 2411383 : result = build_binary_op (location, code, op1, op2, needconvert);
2528 2411383 : if (check != NULL)
2529 3736 : result = build2 (COMPOUND_EXPR, TREE_TYPE (result), check, result);
2530 :
2531 2411383 : if (SCALAR_FLOAT_TYPE_P (type1))
2532 1606 : m2expr_checkRealOverflow (location, code, result);
2533 : return result;
2534 : }
2535 :
2536 : /* build_binary_op, a wrapper for the lower level build_binary_op
2537 : above. */
2538 :
2539 : tree
2540 2360879 : m2expr_build_binary_op (location_t location, enum tree_code code, tree op1,
2541 : tree op2, int convert)
2542 : {
2543 2360879 : return m2expr_build_binary_op_check (location, code, op1, op2, convert, NULL,
2544 2360879 : NULL, NULL);
2545 : }
2546 :
2547 : /* BuildAddAddress return an expression op1+op2 where op1 is a
2548 : pointer type and op2 is not a pointer type. */
2549 :
2550 : tree
2551 0 : m2expr_BuildAddAddress (location_t location, tree op1, tree op2)
2552 : {
2553 0 : tree type1, type2;
2554 :
2555 0 : op1 = m2expr_FoldAndStrip (op1);
2556 0 : op2 = m2expr_FoldAndStrip (op2);
2557 :
2558 0 : type1 = m2tree_skip_type_decl (TREE_TYPE (op1));
2559 0 : type2 = m2tree_skip_type_decl (TREE_TYPE (op2));
2560 :
2561 0 : m2assert_AssertLocation (location);
2562 0 : ASSERT_CONDITION (POINTER_TYPE_P (type1));
2563 0 : ASSERT_CONDITION (!POINTER_TYPE_P (type2));
2564 :
2565 0 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2566 0 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
2567 : m2expr_FoldAndStrip (op1),
2568 0 : m2expr_FoldAndStrip (op2));
2569 : }
2570 :
2571 : /* BuildNegateCheck builds a negate tree. */
2572 :
2573 : tree
2574 912 : m2expr_BuildNegateCheck (location_t location, tree arg, tree lowest, tree min,
2575 : tree max)
2576 : {
2577 912 : tree t;
2578 :
2579 912 : m2assert_AssertLocation (location);
2580 :
2581 912 : arg = m2expr_FoldAndStrip (arg);
2582 912 : arg = CheckAddressToCardinal (location, arg);
2583 :
2584 912 : t = m2expr_build_unary_op_check (location, NEGATE_EXPR, arg, lowest, min,
2585 : max);
2586 912 : return m2expr_FoldAndStrip (t);
2587 : }
2588 :
2589 : /* BuildNegate build a negate expression and returns the tree. */
2590 :
2591 : tree
2592 23063 : m2expr_BuildNegate (location_t location, tree op1, bool needconvert)
2593 : {
2594 23063 : m2assert_AssertLocation (location);
2595 23063 : op1 = m2expr_FoldAndStrip (op1);
2596 23063 : op1 = CheckAddressToCardinal (location, op1);
2597 :
2598 23063 : return m2expr_build_unary_op (location, NEGATE_EXPR, op1, needconvert);
2599 : }
2600 :
2601 : /* BuildSetNegate build a set negate expression and returns the tree. */
2602 :
2603 : tree
2604 808 : m2expr_BuildSetNegate (location_t location, tree value)
2605 : {
2606 808 : m2assert_AssertLocation (location);
2607 :
2608 808 : return m2expr_build_binary_op (
2609 : location, BIT_XOR_EXPR,
2610 : m2convert_BuildConvert (location, m2type_GetWordType (),
2611 : m2expr_FoldAndStrip (value), false),
2612 808 : set_full_complement, false);
2613 : }
2614 :
2615 : /* BuildMult build a multiplication tree. */
2616 :
2617 : tree
2618 31100 : m2expr_BuildMult (location_t location, tree op1, tree op2, bool needconvert)
2619 : {
2620 31100 : op1 = m2expr_FoldAndStrip (op1);
2621 31100 : op2 = m2expr_FoldAndStrip (op2);
2622 :
2623 31100 : m2assert_AssertLocation (location);
2624 :
2625 31100 : op1 = CheckAddressToCardinal (location, op1);
2626 31100 : op2 = CheckAddressToCardinal (location, op2);
2627 :
2628 31100 : return m2expr_build_binary_op (location, MULT_EXPR, op1, op2, needconvert);
2629 : }
2630 :
2631 : /* BuildMultCheck builds a multiplication tree. */
2632 :
2633 : tree
2634 11456 : m2expr_BuildMultCheck (location_t location, tree op1, tree op2, tree lowest,
2635 : tree min, tree max)
2636 : {
2637 11456 : tree t;
2638 :
2639 11456 : m2assert_AssertLocation (location);
2640 :
2641 11456 : op1 = m2expr_FoldAndStrip (op1);
2642 11456 : op2 = m2expr_FoldAndStrip (op2);
2643 :
2644 11456 : op1 = CheckAddressToCardinal (location, op1);
2645 11456 : op2 = CheckAddressToCardinal (location, op2);
2646 :
2647 11456 : t = m2expr_build_binary_op_check (location, MULT_EXPR, op1, op2, false,
2648 : lowest, min, max);
2649 11456 : return m2expr_FoldAndStrip (t);
2650 : }
2651 :
2652 : /* testLimits return the number of bits required to represent:
2653 : min..max if it matches the, type. Otherwise NULL_TREE is returned. */
2654 :
2655 : static tree
2656 20556 : testLimits (location_t location, tree type, tree min, tree max)
2657 : {
2658 20556 : m2assert_AssertLocation (location);
2659 :
2660 20556 : if ((m2expr_CompareTrees (TYPE_MAX_VALUE (type), max) == 0)
2661 20556 : && (m2expr_CompareTrees (TYPE_MIN_VALUE (type), min) == 0))
2662 126 : return m2expr_BuildMult (location, m2expr_GetSizeOf (location, type),
2663 : m2decl_BuildIntegerConstant (BITS_PER_UNIT),
2664 126 : false);
2665 : return NULL_TREE;
2666 : }
2667 :
2668 : /* noBitsRequired return the number of bits required to contain, values. */
2669 :
2670 : static tree
2671 10152 : noBitsRequired (tree values)
2672 : {
2673 10152 : int bits = tree_floor_log2 (values);
2674 :
2675 10152 : return m2decl_BuildIntegerConstant (bits + 1);
2676 : }
2677 :
2678 : /* getMax return the result of max (a, b). */
2679 :
2680 : static tree
2681 10152 : getMax (tree a, tree b)
2682 : {
2683 10152 : if (m2expr_CompareTrees (a, b) > 0)
2684 : return a;
2685 : else
2686 10152 : return b;
2687 : }
2688 :
2689 : /* calcNbits return the smallest number of bits required to
2690 : represent: min..max. */
2691 :
2692 : tree
2693 10278 : m2expr_calcNbits (location_t location, tree min, tree max)
2694 : {
2695 10278 : int negative = false;
2696 10278 : tree t = testLimits (location, m2type_GetIntegerType (), min, max);
2697 :
2698 10278 : m2assert_AssertLocation (location);
2699 :
2700 10278 : if (t == NULL)
2701 10278 : t = testLimits (location, m2type_GetCardinalType (), min, max);
2702 :
2703 10278 : if (t == NULL)
2704 : {
2705 10152 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) < 0)
2706 : {
2707 0 : min = m2expr_BuildAdd (location, min,
2708 : m2expr_GetIntegerOne (location), false);
2709 0 : min = fold (m2expr_BuildNegate (location, min, false));
2710 0 : negative = true;
2711 : }
2712 10152 : if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
2713 : {
2714 12 : max = fold (m2expr_BuildNegate (location, max, false));
2715 12 : negative = true;
2716 : }
2717 20304 : t = noBitsRequired (getMax (min, max));
2718 10152 : if (negative)
2719 12 : t = m2expr_BuildAdd (location, t, m2expr_GetIntegerOne (location),
2720 : false);
2721 : }
2722 10278 : return t;
2723 : }
2724 :
2725 : /* BuildTBitSize return the minimum number of bits to represent type.
2726 : This function is called internally by cc1gm2 to calculate the bits
2727 : size of a type and is used to position record fields. */
2728 :
2729 : tree
2730 6284 : m2expr_BuildTBitSize (location_t location, tree type)
2731 : {
2732 6320 : enum tree_code code = TREE_CODE (type);
2733 6320 : tree min;
2734 6320 : tree max;
2735 6320 : m2assert_AssertLocation (location);
2736 :
2737 6320 : switch (code)
2738 : {
2739 :
2740 36 : case TYPE_DECL:
2741 36 : return m2expr_BuildTBitSize (location, TREE_TYPE (type));
2742 6284 : case INTEGER_TYPE:
2743 6284 : case ENUMERAL_TYPE:
2744 6284 : max = m2convert_BuildConvert (location, m2type_GetIntegerType (),
2745 6284 : TYPE_MAX_VALUE (type), false);
2746 6284 : min = m2convert_BuildConvert (location, m2type_GetIntegerType (),
2747 6284 : TYPE_MIN_VALUE (type), false);
2748 6284 : return m2expr_calcNbits (location, min, max);
2749 0 : case BOOLEAN_TYPE:
2750 0 : return m2expr_GetIntegerOne (location);
2751 0 : default:
2752 0 : return m2expr_BuildMult (location, m2expr_GetSizeOf (location, type),
2753 : m2decl_BuildIntegerConstant (BITS_PER_UNIT),
2754 0 : false);
2755 : }
2756 : }
2757 :
2758 : /* BuildSystemTBitSize return the minimum number of bits to represent type.
2759 : This function is called when evaluating SYSTEM.TBITSIZE. */
2760 :
2761 : tree
2762 6376 : m2expr_BuildSystemTBitSize (location_t location, tree type)
2763 : {
2764 6376 : enum tree_code code = TREE_CODE (type);
2765 6376 : m2assert_AssertLocation (location);
2766 6376 : if (code == TYPE_DECL)
2767 6176 : return m2expr_BuildTBitSize (location, TREE_TYPE (type));
2768 200 : return TYPE_SIZE (type);
2769 : }
2770 :
2771 : /* BuildSize build a SIZE function expression and returns the tree. */
2772 :
2773 : tree
2774 600050 : m2expr_BuildSize (location_t location, tree op1,
2775 : bool needconvert ATTRIBUTE_UNUSED)
2776 : {
2777 600050 : m2assert_AssertLocation (location);
2778 600050 : return m2expr_GetSizeOf (location, op1);
2779 : }
2780 :
2781 : /* BuildAddr return an expression which calculates the address of op1
2782 : and returns the tree. If use_generic is true then create a generic
2783 : pointer type. */
2784 :
2785 : tree
2786 394345 : m2expr_BuildAddr (location_t location, tree op1, bool use_generic)
2787 : {
2788 394345 : tree type = m2tree_skip_type_decl (TREE_TYPE (op1));
2789 394345 : tree ptrType = build_pointer_type (type);
2790 394345 : tree result;
2791 :
2792 394345 : m2assert_AssertLocation (location);
2793 :
2794 394345 : if (!gm2_mark_addressable (op1))
2795 0 : error_at (location, "cannot take the address of this expression");
2796 :
2797 394345 : if (use_generic)
2798 12 : result = build1 (ADDR_EXPR, m2type_GetPointerType (), op1);
2799 : else
2800 394333 : result = build1 (ADDR_EXPR, ptrType, op1);
2801 394345 : protected_set_expr_location (result, location);
2802 394345 : return result;
2803 : }
2804 :
2805 : /* BuildOffset1 build and return an expression containing the number
2806 : of bytes the field is offset from the start of the record structure.
2807 : This function is the same as the above, except that it derives the
2808 : record from the field and then calls BuildOffset. */
2809 :
2810 : tree
2811 0 : m2expr_BuildOffset1 (location_t location, tree field,
2812 : bool needconvert ATTRIBUTE_UNUSED)
2813 : {
2814 0 : m2assert_AssertLocation (location);
2815 0 : return m2expr_BuildOffset (location, DECL_CONTEXT (field), field,
2816 0 : needconvert);
2817 : }
2818 :
2819 : /* determinePenultimateField return the field associated with the
2820 : DECL_CONTEXT (field) within a record or varient. The record, is a
2821 : record/varient but it maybe an outer nested record to the field that
2822 : we are searching. Ie:
2823 :
2824 : record = RECORD x: CARDINAL ; y: RECORD field: CARDINAL ; END END ;
2825 :
2826 : determinePenultimateField (record, field) returns, y. We are
2827 : assurred that the chain of records leading to field will be unique as
2828 : they are built on the fly to implement varient records. */
2829 :
2830 : static tree
2831 3340 : determinePenultimateField (tree record, tree field)
2832 : {
2833 3340 : tree fieldlist = TYPE_FIELDS (record);
2834 3340 : tree x, r;
2835 :
2836 9800 : for (x = fieldlist; x; x = TREE_CHAIN (x))
2837 : {
2838 9370 : if (DECL_CONTEXT (field) == TREE_TYPE (x))
2839 : return x;
2840 7542 : switch (TREE_CODE (TREE_TYPE (x)))
2841 : {
2842 1512 : case RECORD_TYPE:
2843 1512 : case UNION_TYPE:
2844 1512 : r = determinePenultimateField (TREE_TYPE (x), field);
2845 1512 : if (r != NULL)
2846 : return r;
2847 : break;
2848 : default:
2849 : break;
2850 : }
2851 : }
2852 : return NULL_TREE;
2853 : }
2854 :
2855 : /* BuildOffset builds an expression containing the number of bytes
2856 : the field is offset from the start of the record structure. The
2857 : expression is returned. */
2858 :
2859 : tree
2860 0 : m2expr_BuildOffset (location_t location, tree record, tree field,
2861 : bool needconvert ATTRIBUTE_UNUSED)
2862 : {
2863 0 : m2assert_AssertLocation (location);
2864 :
2865 0 : if (DECL_CONTEXT (field) == record)
2866 0 : return m2convert_BuildConvert (
2867 : location, m2type_GetIntegerType (),
2868 : m2expr_BuildAdd (
2869 0 : location, DECL_FIELD_OFFSET (field),
2870 0 : m2expr_BuildDivTrunc (location, DECL_FIELD_BIT_OFFSET (field),
2871 : m2decl_BuildIntegerConstant (BITS_PER_UNIT),
2872 : false),
2873 : false),
2874 0 : false);
2875 : else
2876 : {
2877 0 : tree r1 = DECL_CONTEXT (field);
2878 0 : tree r2 = determinePenultimateField (record, field);
2879 0 : return m2convert_BuildConvert (
2880 : location, m2type_GetIntegerType (),
2881 : m2expr_BuildAdd (
2882 : location, m2expr_BuildOffset (location, r1, field, needconvert),
2883 : m2expr_BuildOffset (location, record, r2, needconvert), false),
2884 0 : false);
2885 : }
2886 : }
2887 :
2888 : /* BuildLogicalOrAddress build a logical or expressions and return the tree. */
2889 :
2890 : tree
2891 12 : m2expr_BuildLogicalOrAddress (location_t location, tree op1, tree op2)
2892 : {
2893 12 : m2assert_AssertLocation (location);
2894 12 : return m2expr_build_binary_op (location, BIT_IOR_EXPR, op1, op2, false);
2895 : }
2896 :
2897 : /* BuildLogicalOr build a logical or expressions and return the tree. */
2898 :
2899 : tree
2900 504478 : m2expr_BuildLogicalOr (location_t location, tree op1, tree op2)
2901 : {
2902 504478 : m2assert_AssertLocation (location);
2903 504478 : return m2expr_build_binary_op (
2904 : location, BIT_IOR_EXPR,
2905 : m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
2906 : m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
2907 504478 : false);
2908 : }
2909 :
2910 : /* BuildLogicalAnd build a logical and expression and return the tree. */
2911 :
2912 : tree
2913 4246 : m2expr_BuildLogicalAnd (location_t location, tree op1, tree op2)
2914 : {
2915 4246 : m2assert_AssertLocation (location);
2916 4246 : return m2expr_build_binary_op (
2917 : location, BIT_AND_EXPR,
2918 : m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
2919 : m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
2920 4246 : false);
2921 : }
2922 :
2923 : /* BuildSymmetricalDifference build a logical xor expression and return the
2924 : tree. */
2925 :
2926 : tree
2927 124 : m2expr_BuildSymmetricDifference (location_t location, tree left, tree right)
2928 : {
2929 124 : m2assert_AssertLocation (location);
2930 124 : return m2expr_build_binary_op (
2931 : location, BIT_XOR_EXPR,
2932 : m2convert_BuildConvert (location, m2type_GetWordType (), left, false),
2933 : m2convert_BuildConvert (location, m2type_GetWordType (), right, false),
2934 124 : false);
2935 : }
2936 :
2937 : /* BuildLogicalDifference build a logical difference expression tree.
2938 : Return (left and (not right)). */
2939 :
2940 : tree
2941 36 : m2expr_BuildLogicalDifference (location_t location, tree left, tree right)
2942 : {
2943 36 : m2assert_AssertLocation (location);
2944 36 : return m2expr_build_binary_op (
2945 : location, BIT_AND_EXPR,
2946 : m2convert_BuildConvert (location, m2type_GetWordType (), left, false),
2947 36 : m2expr_BuildSetNegate (location, right), false);
2948 : }
2949 :
2950 : /* base_type returns the base type of an ordinal subrange, or the
2951 : type itself if it is not a subrange. */
2952 :
2953 : static tree
2954 868978 : base_type (tree type)
2955 : {
2956 868978 : if (type == error_mark_node)
2957 : return error_mark_node;
2958 :
2959 : /* Check for ordinal subranges. */
2960 868978 : if (m2tree_IsOrdinal (type) && TREE_TYPE (type))
2961 106456 : type = TREE_TYPE (type);
2962 868978 : return TYPE_MAIN_VARIANT (type);
2963 : }
2964 :
2965 : /* boolean_enum_to_unsigned convert a BOOLEAN_TYPE value or
2966 : ENUMERAL_TYPE to an unsigned type. */
2967 :
2968 : static tree
2969 449142 : boolean_enum_to_unsigned (location_t location, tree value)
2970 : {
2971 449142 : tree type = TREE_TYPE (value);
2972 :
2973 449142 : if (TREE_CODE (base_type (type)) == BOOLEAN_TYPE)
2974 29306 : return m2convert_BuildConvert (location, unsigned_type_node, value, false);
2975 419836 : else if (TREE_CODE (base_type (type)) == ENUMERAL_TYPE)
2976 1488 : return m2convert_BuildConvert (location, unsigned_type_node, value, false);
2977 : else
2978 : return value;
2979 : }
2980 :
2981 : /* check_for_comparison check to see if, op, is of type, badType. If
2982 : so then it returns op after it has been cast to, goodType. op will
2983 : be an array so we take the address and cast the contents. */
2984 :
2985 : static tree
2986 794104 : check_for_comparison (location_t location, tree op, tree badType,
2987 : tree goodType)
2988 : {
2989 794104 : m2assert_AssertLocation (location);
2990 794104 : if (m2tree_skip_type_decl (TREE_TYPE (op)) == badType)
2991 : /* Cannot compare array contents in m2expr_build_binary_op. */
2992 0 : return m2expr_BuildIndirect (
2993 0 : location, m2expr_BuildAddr (location, op, false), goodType);
2994 : return op;
2995 : }
2996 :
2997 : /* convert_for_comparison return a tree which can be used as an
2998 : argument during a comparison. */
2999 :
3000 : static tree
3001 198526 : convert_for_comparison (location_t location, tree op)
3002 : {
3003 198526 : m2assert_AssertLocation (location);
3004 198526 : op = boolean_enum_to_unsigned (location, op);
3005 :
3006 198526 : op = check_for_comparison (location, op, m2type_GetISOWordType (),
3007 : m2type_GetWordType ());
3008 198526 : op = check_for_comparison (location, op, m2type_GetM2Word16 (),
3009 : m2type_GetM2Cardinal16 ());
3010 198526 : op = check_for_comparison (location, op, m2type_GetM2Word32 (),
3011 : m2type_GetM2Cardinal32 ());
3012 198526 : op = check_for_comparison (location, op, m2type_GetM2Word64 (),
3013 : m2type_GetM2Cardinal64 ());
3014 :
3015 198526 : return op;
3016 : }
3017 :
3018 : /* BuildLessThan return a tree which computes <. */
3019 :
3020 : tree
3021 52595 : m2expr_BuildLessThan (location_t location, tree op1, tree op2)
3022 : {
3023 52595 : m2assert_AssertLocation (location);
3024 52595 : return m2expr_build_binary_op (
3025 : location, LT_EXPR, boolean_enum_to_unsigned (location, op1),
3026 52595 : boolean_enum_to_unsigned (location, op2), true);
3027 : }
3028 :
3029 : /* BuildGreaterThan return a tree which computes >. */
3030 :
3031 : tree
3032 51497 : m2expr_BuildGreaterThan (location_t location, tree op1, tree op2)
3033 : {
3034 51497 : m2assert_AssertLocation (location);
3035 51497 : return m2expr_build_binary_op (
3036 : location, GT_EXPR, boolean_enum_to_unsigned (location, op1),
3037 51497 : boolean_enum_to_unsigned (location, op2), true);
3038 : }
3039 :
3040 : /* BuildLessThanOrEqual return a tree which computes <. */
3041 :
3042 : tree
3043 8620 : m2expr_BuildLessThanOrEqual (location_t location, tree op1, tree op2)
3044 : {
3045 8620 : m2assert_AssertLocation (location);
3046 8620 : return m2expr_build_binary_op (
3047 : location, LE_EXPR, boolean_enum_to_unsigned (location, op1),
3048 8620 : boolean_enum_to_unsigned (location, op2), true);
3049 : }
3050 :
3051 : /* BuildGreaterThanOrEqual return a tree which computes >=. */
3052 :
3053 : tree
3054 12596 : m2expr_BuildGreaterThanOrEqual (location_t location, tree op1, tree op2)
3055 : {
3056 12596 : m2assert_AssertLocation (location);
3057 12596 : return m2expr_build_binary_op (
3058 : location, GE_EXPR, boolean_enum_to_unsigned (location, op1),
3059 12596 : boolean_enum_to_unsigned (location, op2), true);
3060 : }
3061 :
3062 : /* BuildEqualTo return a tree which computes =. */
3063 :
3064 : tree
3065 65614 : m2expr_BuildEqualTo (location_t location, tree op1, tree op2)
3066 : {
3067 65614 : m2assert_AssertLocation (location);
3068 65614 : return m2expr_build_binary_op (location, EQ_EXPR,
3069 : convert_for_comparison (location, op1),
3070 65614 : convert_for_comparison (location, op2), true);
3071 : }
3072 :
3073 : /* BuildEqualNotTo return a tree which computes #. */
3074 :
3075 : tree
3076 33649 : m2expr_BuildNotEqualTo (location_t location, tree op1, tree op2)
3077 : {
3078 33649 : m2assert_AssertLocation (location);
3079 33649 : return m2expr_build_binary_op (location, NE_EXPR,
3080 : convert_for_comparison (location, op1),
3081 33649 : convert_for_comparison (location, op2), true);
3082 : }
3083 :
3084 : /* BuildIsSuperset return a tree which computes: op1 & op2 == op2. */
3085 :
3086 : tree
3087 0 : m2expr_BuildIsSuperset (location_t location, tree op1, tree op2)
3088 : {
3089 0 : m2assert_AssertLocation (location);
3090 0 : return m2expr_BuildEqualTo (
3091 0 : location, op2, m2expr_BuildLogicalAnd (location, op1, op2));
3092 : }
3093 :
3094 : /* BuildIsNotSuperset return a tree which computes: op1 & op2 != op2. */
3095 :
3096 : tree
3097 0 : m2expr_BuildIsNotSuperset (location_t location, tree op1, tree op2)
3098 : {
3099 0 : m2assert_AssertLocation (location);
3100 0 : return m2expr_BuildNotEqualTo (
3101 0 : location, op2, m2expr_BuildLogicalAnd (location, op1, op2));
3102 : }
3103 :
3104 : /* BuildIsSubset return a tree which computes: op1 & op2 == op1. */
3105 :
3106 : tree
3107 0 : m2expr_BuildIsSubset (location_t location, tree op1, tree op2)
3108 : {
3109 0 : m2assert_AssertLocation (location);
3110 0 : return m2expr_BuildEqualTo (
3111 0 : location, op1, m2expr_BuildLogicalAnd (location, op1, op2));
3112 : }
3113 :
3114 : /* BuildIsNotSubset return a tree which computes: op1 & op2 != op1. */
3115 :
3116 : tree
3117 0 : m2expr_BuildIsNotSubset (location_t location, tree op1, tree op2)
3118 : {
3119 0 : m2assert_AssertLocation (location);
3120 0 : return m2expr_BuildNotEqualTo (
3121 0 : location, op1, m2expr_BuildLogicalAnd (location, op1, op2));
3122 : }
3123 :
3124 : /* BuildIfBitInSetJump build and add a statement tree containing:
3125 : if (bit in setvalue) goto label. If invertCondition is true then
3126 : the tree created will take the form:
3127 : if not (bit in setvalue) goto label. */
3128 :
3129 : void
3130 0 : m2expr_BuildIfBitInSetJump (location_t location, bool invertCondition,
3131 : tree setvalue, tree bit, char *label)
3132 : {
3133 0 : if (invertCondition)
3134 0 : m2treelib_do_jump_if_bit (location, NE_EXPR, setvalue, bit, label);
3135 : else
3136 0 : m2treelib_do_jump_if_bit (location, EQ_EXPR, setvalue, bit, label);
3137 0 : }
3138 :
3139 : /* BuildIfInRangeGoto returns a tree containing if var is in the
3140 : range low..high then goto label. */
3141 :
3142 : void
3143 80 : m2expr_BuildIfInRangeGoto (location_t location, tree var, tree low, tree high,
3144 : char *label)
3145 : {
3146 80 : m2assert_AssertLocation (location);
3147 :
3148 80 : if (m2expr_CompareTrees (low, high) == 0)
3149 60 : m2statement_IfExprJump (location, m2expr_BuildEqualTo (location, var, low),
3150 : label);
3151 : else
3152 20 : m2statement_IfExprJump (
3153 : location,
3154 : m2expr_build_binary_op (
3155 : location, TRUTH_ANDIF_EXPR,
3156 : m2expr_BuildGreaterThanOrEqual (location, var, low),
3157 : m2expr_BuildLessThanOrEqual (location, var, high), false),
3158 : label);
3159 80 : }
3160 :
3161 : /* BuildIfNotInRangeGoto returns a tree containing if var is not in
3162 : the range low..high then goto label. */
3163 :
3164 : void
3165 24 : m2expr_BuildIfNotInRangeGoto (location_t location, tree var, tree low,
3166 : tree high, char *label)
3167 : {
3168 24 : m2assert_AssertLocation (location);
3169 :
3170 24 : if (m2expr_CompareTrees (low, high) == 0)
3171 0 : m2statement_IfExprJump (location, m2expr_BuildNotEqualTo (location, var, low),
3172 : label);
3173 : else
3174 24 : m2statement_IfExprJump (
3175 : location, m2expr_build_binary_op (
3176 : location, TRUTH_ORIF_EXPR,
3177 : m2expr_BuildLessThan (location, var, low),
3178 : m2expr_BuildGreaterThan (location, var, high), false),
3179 : label);
3180 24 : }
3181 :
3182 : /* BuildArray - returns a tree which accesses array[index] given,
3183 : lowIndice. */
3184 :
3185 : tree
3186 51606 : m2expr_BuildArray (location_t location, tree type, tree array, tree index,
3187 : tree low_indice)
3188 : {
3189 51606 : tree array_type = m2tree_skip_type_decl (TREE_TYPE (array));
3190 51606 : tree index_type = TYPE_DOMAIN (array_type);
3191 51606 : type = m2tree_skip_type_decl (type);
3192 : // ASSERT_CONDITION (low_indice == TYPE_MIN_VALUE (index_type));
3193 :
3194 51606 : low_indice
3195 51606 : = m2convert_BuildConvert (location, index_type, low_indice, false);
3196 51606 : return build4_loc (location, ARRAY_REF, type, array, index, low_indice,
3197 51606 : NULL_TREE);
3198 : }
3199 :
3200 : /* BuildComponentRef - build a component reference tree which
3201 : accesses record.field. If field does not belong to record it
3202 : calls BuildComponentRef on the penultimate field. */
3203 :
3204 : tree
3205 184002 : m2expr_BuildComponentRef (location_t location, tree record, tree field)
3206 : {
3207 185830 : tree recordType = m2tree_skip_reference_type (
3208 185830 : m2tree_skip_type_decl (TREE_TYPE (record)));
3209 :
3210 185830 : if (DECL_CONTEXT (field) == recordType)
3211 184002 : return build3 (COMPONENT_REF, TREE_TYPE (field), record, field, NULL_TREE);
3212 : else
3213 : {
3214 1828 : tree f = determinePenultimateField (recordType, field);
3215 1828 : return m2expr_BuildComponentRef (
3216 1828 : location, m2expr_BuildComponentRef (location, record, f), field);
3217 : }
3218 : }
3219 :
3220 : /* BuildIndirect - build: (*target) given that the object to be
3221 : copied is of, type. */
3222 :
3223 : tree
3224 110323 : m2expr_BuildIndirect (location_t location ATTRIBUTE_UNUSED, tree target,
3225 : tree type)
3226 : {
3227 : /* Note that the second argument to build1 is:
3228 :
3229 : TYPE_QUALS is a list of modifiers such as const or volatile to apply
3230 : to the pointer type, represented as identifiers.
3231 :
3232 : it also determines the type of arithmetic and size of the object to
3233 : be indirectly moved. */
3234 :
3235 110323 : tree t1 = m2tree_skip_type_decl (type);
3236 110323 : tree t2 = build_pointer_type (t1);
3237 :
3238 110323 : m2assert_AssertLocation (location);
3239 :
3240 110323 : return build1 (INDIRECT_REF, t1,
3241 110323 : m2convert_BuildConvert (location, t2, target, false));
3242 : }
3243 :
3244 : /* IsTrue - returns true if, t, is known to be true. */
3245 :
3246 : bool
3247 53340 : m2expr_IsTrue (tree t)
3248 : {
3249 53340 : return (m2expr_FoldAndStrip (t) == m2type_GetBooleanTrue ());
3250 : }
3251 :
3252 : /* IsFalse - returns false if, t, is known to be false. */
3253 :
3254 : bool
3255 0 : m2expr_IsFalse (tree t)
3256 : {
3257 0 : return (m2expr_FoldAndStrip (t) == m2type_GetBooleanFalse ());
3258 : }
3259 :
3260 : /* AreConstantsEqual - maps onto tree.cc (tree_int_cst_equal). It
3261 : returns true if the value of e1 is the same as e2. */
3262 :
3263 : bool
3264 1196203 : m2expr_AreConstantsEqual (tree e1, tree e2)
3265 : {
3266 1196203 : return tree_int_cst_equal (e1, e2) != 0;
3267 : }
3268 :
3269 : /* AreRealOrComplexConstantsEqual - returns true if constants, e1 and
3270 : e2 are equal according to IEEE rules. This does not perform bit
3271 : equivalence for example IEEE states that -0 == 0 and NaN != NaN. */
3272 :
3273 : bool
3274 162 : m2expr_AreRealOrComplexConstantsEqual (tree e1, tree e2)
3275 : {
3276 162 : if (TREE_CODE (e1) == COMPLEX_CST)
3277 54 : return (m2expr_AreRealOrComplexConstantsEqual (TREE_REALPART (e1),
3278 54 : TREE_REALPART (e2))
3279 108 : && m2expr_AreRealOrComplexConstantsEqual (TREE_IMAGPART (e1),
3280 54 : TREE_IMAGPART (e2)));
3281 : else
3282 108 : return real_compare (EQ_EXPR, &TREE_REAL_CST (e1), &TREE_REAL_CST (e2));
3283 : }
3284 :
3285 : /* DetermineSign, returns -1 if e<0 0 if e==0 1 if e>0
3286 : an unsigned constant will never return -1. */
3287 :
3288 : int
3289 0 : m2expr_DetermineSign (tree e)
3290 : {
3291 0 : return tree_int_cst_sgn (e);
3292 : }
3293 :
3294 : /* Similar to build_int_2 () but allows you to specify the type of
3295 : the integer constant that you are creating. */
3296 :
3297 : static tree
3298 318 : build_int_2_type (HOST_WIDE_INT low, HOST_WIDE_INT hi, tree type)
3299 : {
3300 318 : tree value;
3301 318 : HOST_WIDE_INT ival[3];
3302 :
3303 318 : ival[0] = low;
3304 318 : ival[1] = hi;
3305 318 : ival[2] = 0;
3306 :
3307 318 : widest_int wval = widest_int::from_array (ival, 3);
3308 318 : value = wide_int_to_tree (type, wval);
3309 :
3310 318 : return value;
3311 318 : }
3312 :
3313 : /* BuildCap - builds the Modula-2 function CAP(t) and returns the
3314 : result in a gcc Tree. */
3315 :
3316 : tree
3317 106 : m2expr_BuildCap (location_t location, tree t)
3318 : {
3319 106 : tree tt;
3320 106 : tree out_of_range, less_than, greater_than, translated;
3321 :
3322 106 : m2assert_AssertLocation (location);
3323 :
3324 106 : t = fold (t);
3325 106 : if (t == error_mark_node)
3326 : return error_mark_node;
3327 :
3328 106 : tt = TREE_TYPE (t);
3329 :
3330 106 : t = fold (convert (m2type_GetM2CharType (), t));
3331 :
3332 106 : if (TREE_CODE (tt) == INTEGER_TYPE)
3333 : {
3334 106 : less_than = fold (m2expr_build_binary_op (
3335 : location, LT_EXPR, t,
3336 : build_int_2_type ('a', 0, m2type_GetM2CharType ()), 0));
3337 106 : greater_than = fold (m2expr_build_binary_op (
3338 : location, GT_EXPR, t,
3339 : build_int_2_type ('z', 0, m2type_GetM2CharType ()), 0));
3340 106 : out_of_range = fold (m2expr_build_binary_op (
3341 : location, TRUTH_ORIF_EXPR, less_than, greater_than, 0));
3342 :
3343 106 : translated = fold (convert (
3344 : m2type_GetM2CharType (),
3345 : m2expr_build_binary_op (
3346 : location, MINUS_EXPR, t,
3347 : build_int_2_type ('a' - 'A', 0, m2type_GetM2CharType ()), 0)));
3348 :
3349 106 : return fold_build3 (COND_EXPR, m2type_GetM2CharType (), out_of_range, t,
3350 : translated);
3351 : }
3352 :
3353 0 : error_at (location,
3354 : "argument to CAP is not a constant or variable of type CHAR");
3355 0 : return error_mark_node;
3356 : }
3357 :
3358 : /* BuildDivM2 if iso or pim4 then all modulus results are positive
3359 : and the results from the division are rounded to the floor otherwise
3360 : use BuildDivTrunc. */
3361 :
3362 : tree
3363 4192 : m2expr_BuildDivM2 (location_t location, tree op1, tree op2,
3364 : bool needsconvert)
3365 : {
3366 4192 : op1 = m2expr_FoldAndStrip (op1);
3367 4192 : op2 = m2expr_FoldAndStrip (op2);
3368 4192 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3369 : /* If iso or pim4 then build and return ((op2 < 0) ? (op1
3370 : divceil op2) : (op1 divfloor op2)) otherwise use divtrunc. */
3371 4220 : if (M2Options_GetPIM4 () || M2Options_GetISO ()
3372 4220 : || M2Options_GetPositiveModFloor ())
3373 4164 : return fold_build3 (
3374 : COND_EXPR, TREE_TYPE (op1),
3375 : m2expr_BuildLessThan (
3376 : location, op2,
3377 : m2convert_BuildConvert (location, TREE_TYPE (op2),
3378 : m2expr_GetIntegerZero (location), false)),
3379 : m2expr_BuildDivCeil (location, op1, op2, needsconvert),
3380 : m2expr_BuildDivFloor (location, op1, op2, needsconvert));
3381 : else
3382 28 : return m2expr_BuildDivTrunc (location, op1, op2, needsconvert);
3383 : }
3384 :
3385 : /* BuildDivM2Check - build and
3386 : return ((op2 < 0) ? (op1 divtrunc op2) : (op1 divfloor op2))
3387 : when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
3388 : return op1 div trunc op2. Use the checking div equivalents. */
3389 :
3390 : tree
3391 1940 : m2expr_BuildDivM2Check (location_t location, tree op1, tree op2,
3392 : tree lowest, tree min, tree max)
3393 : {
3394 1940 : op1 = m2expr_FoldAndStrip (op1);
3395 1940 : op2 = m2expr_FoldAndStrip (op2);
3396 1940 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3397 1940 : if (M2Options_GetISO ()
3398 1940 : || M2Options_GetPIM4 () || M2Options_GetPositiveModFloor ())
3399 1908 : return fold_build3 (
3400 : COND_EXPR, TREE_TYPE (op1),
3401 : m2expr_BuildLessThan (
3402 : location, op2,
3403 : m2convert_BuildConvert (location, TREE_TYPE (op2),
3404 : m2expr_GetIntegerZero (location), false)),
3405 : m2expr_BuildDivCeilCheck (location, op1, op2, lowest, min, max),
3406 : m2expr_BuildDivFloorCheck (location, op1, op2, lowest, min, max));
3407 : else
3408 32 : return m2expr_BuildDivTruncCheck (location, op1, op2, lowest, min, max);
3409 : }
3410 :
3411 : static
3412 : tree
3413 2084 : m2expr_BuildISOModM2Check (location_t location,
3414 : tree op1, tree op2, tree lowest, tree min, tree max)
3415 : {
3416 4168 : tree cond = m2expr_BuildLessThan (location, op2,
3417 2084 : m2convert_BuildConvert (location, TREE_TYPE (op2),
3418 : m2expr_GetIntegerZero (location), false));
3419 :
3420 : /* Return the result of the modulus. */
3421 2084 : return fold_build3 (COND_EXPR, TREE_TYPE (op1), cond,
3422 : /* op2 < 0. */
3423 : m2expr_BuildModCeilCheck (location, op1, op2, lowest, min, max),
3424 : /* op2 >= 0. */
3425 : m2expr_BuildModFloorCheck (location, op1, op2, lowest, min, max));
3426 : }
3427 :
3428 :
3429 : /* BuildModM2Check if iso or pim4 then build and return ((op2 < 0) ? (op1
3430 : modceil op2) : (op1 modfloor op2)) otherwise use modtrunc.
3431 : Use the checking mod equivalents. */
3432 :
3433 : tree
3434 2088 : m2expr_BuildModM2Check (location_t location, tree op1, tree op2,
3435 : tree lowest, tree min, tree max)
3436 : {
3437 2088 : op1 = m2expr_FoldAndStrip (op1);
3438 2088 : op2 = m2expr_FoldAndStrip (op2);
3439 2088 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3440 2092 : if (M2Options_GetPIM4 () || M2Options_GetISO ()
3441 2092 : || M2Options_GetPositiveModFloor ())
3442 2084 : return m2expr_BuildISOModM2Check (location, op1, op2, lowest, min, max);
3443 : else
3444 4 : return m2expr_BuildModTruncCheck (location, op1, op2, lowest, min, max);
3445 : }
3446 :
3447 : /* BuildModM2 if iso or pim4 then build and return ((op2 < 0) ? (op1
3448 : modceil op2) : (op1 modfloor op2)) otherwise use modtrunc. */
3449 :
3450 : tree
3451 250 : m2expr_BuildModM2 (location_t location, tree op1, tree op2,
3452 : bool needsconvert)
3453 : {
3454 250 : op1 = m2expr_FoldAndStrip (op1);
3455 250 : op2 = m2expr_FoldAndStrip (op2);
3456 250 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3457 322 : if (M2Options_GetPIM4 () || M2Options_GetISO ()
3458 322 : || M2Options_GetPositiveModFloor ())
3459 178 : return fold_build3 (
3460 : COND_EXPR, TREE_TYPE (op1),
3461 : m2expr_BuildLessThan (
3462 : location, op2,
3463 : m2convert_BuildConvert (location, TREE_TYPE (op2),
3464 : m2expr_GetIntegerZero (location), false)),
3465 : m2expr_BuildModCeil (location, op1, op2, needsconvert),
3466 : m2expr_BuildModFloor (location, op1, op2, needsconvert));
3467 : else
3468 72 : return m2expr_BuildModTrunc (location, op1, op2, needsconvert);
3469 : }
3470 :
3471 : /* BuildAbs build the Modula-2 function ABS(t) and return the result
3472 : in a gcc Tree. */
3473 :
3474 : tree
3475 1256 : m2expr_BuildAbs (location_t location, tree t)
3476 : {
3477 1256 : m2assert_AssertLocation (location);
3478 :
3479 1256 : return m2expr_build_unary_op (location, ABS_EXPR, t, 0);
3480 : }
3481 :
3482 : /* BuildRe build an expression for the function RE. */
3483 :
3484 : tree
3485 54 : m2expr_BuildRe (tree op1)
3486 : {
3487 54 : op1 = m2expr_FoldAndStrip (op1);
3488 54 : if (TREE_CODE (op1) == COMPLEX_CST)
3489 36 : return fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3490 : else
3491 18 : return build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3492 : }
3493 :
3494 : /* BuildIm build an expression for the function IM. */
3495 :
3496 : tree
3497 54 : m2expr_BuildIm (tree op1)
3498 : {
3499 54 : op1 = m2expr_FoldAndStrip (op1);
3500 54 : if (TREE_CODE (op1) == COMPLEX_CST)
3501 36 : return fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3502 : else
3503 18 : return build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3504 : }
3505 :
3506 : /* BuildCmplx build an expression for the function CMPLX. */
3507 :
3508 : tree
3509 486 : m2expr_BuildCmplx (location_t location, tree type, tree real, tree imag)
3510 : {
3511 486 : tree scalor;
3512 486 : real = m2expr_FoldAndStrip (real);
3513 486 : imag = m2expr_FoldAndStrip (imag);
3514 486 : type = m2tree_skip_type_decl (type);
3515 486 : scalor = TREE_TYPE (type);
3516 :
3517 486 : if (scalor != TREE_TYPE (real))
3518 6 : real = m2convert_BuildConvert (location, scalor, real, false);
3519 486 : if (scalor != TREE_TYPE (imag))
3520 18 : imag = m2convert_BuildConvert (location, scalor, imag, false);
3521 :
3522 486 : if ((TREE_CODE (real) == REAL_CST) && (TREE_CODE (imag) == REAL_CST))
3523 408 : return build_complex (type, real, imag);
3524 : else
3525 78 : return build2 (COMPLEX_EXPR, type, real, imag);
3526 : }
3527 :
3528 : void
3529 0 : m2expr_SetAndNarrow (location_t location, tree settype,
3530 : tree op1, tree op2, tree op3,
3531 : bool is_op1lvalue, bool is_op2lvalue, bool is_op3lvalue)
3532 : {
3533 0 : m2statement_BuildAssignmentTree (
3534 : location, m2expr_GetRValue (location, op1, settype, is_op1lvalue),
3535 : m2expr_BuildLogicalAnd (
3536 : location, m2expr_GetRValue (location, op2, settype, is_op2lvalue),
3537 : m2expr_GetRValue (location, op3, settype, is_op3lvalue)));
3538 0 : }
3539 :
3540 : /* OverflowZType returns true if the ZTYPE str will exceed the
3541 : internal representation. This routine is much faster (at
3542 : least 2 orders of magnitude faster) than the char at a time overflow
3543 : detection used in ToWideInt and so it should be
3544 : used to filter out erroneously large constants before calling ToWideInt
3545 : allowing a quick fail. */
3546 :
3547 : bool
3548 1548071 : m2expr_OverflowZType (location_t location, const char *str, unsigned int base,
3549 : bool issueError)
3550 : {
3551 1548071 : int length = strlen (str);
3552 1548071 : bool overflow = false;
3553 :
3554 1548071 : switch (base)
3555 : {
3556 72 : case 2:
3557 72 : overflow = ((length -1) > WIDE_INT_MAX_PRECISION);
3558 72 : break;
3559 247020 : case 8:
3560 247020 : overflow = (((length -1) * 3) > WIDE_INT_MAX_PRECISION);
3561 247020 : break;
3562 1298909 : case 10:
3563 1298909 : {
3564 1298909 : int str_log10 = length;
3565 1298909 : int bits_str = (int) (((float) (str_log10)) / log10f (2.0)) + 1;
3566 1298909 : overflow = (bits_str > WIDE_INT_MAX_PRECISION);
3567 : }
3568 1298909 : break;
3569 2070 : case 16:
3570 2070 : overflow = (((length -1) * 4) > WIDE_INT_MAX_PRECISION);
3571 2070 : break;
3572 0 : default:
3573 0 : gcc_unreachable ();
3574 : }
3575 1548071 : if (issueError && overflow)
3576 6 : error_at (location,
3577 : "constant literal %qs exceeds internal ZTYPE range", str);
3578 1548071 : return overflow;
3579 : }
3580 :
3581 :
3582 : /* ToWideInt converts a ZTYPE str value into result. */
3583 :
3584 : static
3585 : bool
3586 603865 : ToWideInt (location_t location, const char *str, unsigned int base,
3587 : widest_int &result, bool issueError)
3588 : {
3589 603865 : tree type = m2type_GetM2ZType ();
3590 603865 : unsigned int i = 0;
3591 603865 : wi::overflow_type overflow = wi::OVF_NONE;
3592 603865 : widest_int wbase = wi::to_widest (m2decl_BuildIntegerConstant (base));
3593 603865 : unsigned int digit = 0;
3594 603865 : result = wi::to_widest (m2decl_BuildIntegerConstant (0));
3595 603865 : bool base_specifier = false;
3596 :
3597 1662706 : while (((str[i] != (char)0) && (overflow == wi::OVF_NONE))
3598 2721547 : && (! base_specifier))
3599 : {
3600 1058841 : char ch = str[i];
3601 :
3602 1058841 : switch (base)
3603 : {
3604 : /* GNU m2 extension allows 'A' to represent binary literals. */
3605 156 : case 2:
3606 156 : if (ch == 'A')
3607 : base_specifier = true;
3608 156 : else if ((ch < '0') || (ch > '1'))
3609 : {
3610 0 : if (issueError)
3611 0 : error_at (location,
3612 : "constant literal %qs contains %qc, expected 0 or 1",
3613 : str, ch);
3614 0 : return true;
3615 : }
3616 : else
3617 156 : digit = (unsigned int) (ch - '0');
3618 : break;
3619 364224 : case 8:
3620 : /* An extension of 'B' indicates octal ZTYPE and 'C' octal character. */
3621 364224 : if ((ch == 'B') || (ch == 'C'))
3622 : base_specifier = true;
3623 364224 : else if ((ch < '0') || (ch > '7'))
3624 : {
3625 0 : if (issueError)
3626 0 : error_at (location,
3627 : "constant literal %qs contains %qc, expected %qs",
3628 : str, ch, "0..7");
3629 0 : return true;
3630 : }
3631 : else
3632 364224 : digit = (unsigned int) (ch - '0');
3633 : break;
3634 691215 : case 10:
3635 691215 : if ((ch < '0') || (ch > '9'))
3636 : {
3637 0 : if (issueError)
3638 0 : error_at (location,
3639 : "constant literal %qs contains %qc, expected %qs",
3640 : str, ch, "0..9");
3641 0 : return true;
3642 : }
3643 : else
3644 691215 : digit = (unsigned int) (ch - '0');
3645 691215 : break;
3646 3246 : case 16:
3647 : /* An extension of 'H' indicates hexidecimal ZTYPE. */
3648 3246 : if (ch == 'H')
3649 : base_specifier = true;
3650 3246 : else if ((ch >= '0') && (ch <= '9'))
3651 2472 : digit = (unsigned int) (ch - '0');
3652 774 : else if ((ch >= 'A') && (ch <= 'F'))
3653 774 : digit = ((unsigned int) (ch - 'A')) + 10;
3654 : else
3655 : {
3656 0 : if (issueError)
3657 0 : error_at (location,
3658 : "constant literal %qs contains %qc, expected %qs or %qs",
3659 : str, ch, "0..9", "A..F");
3660 0 : return true;
3661 : }
3662 : break;
3663 0 : default:
3664 0 : gcc_unreachable ();
3665 : }
3666 :
3667 1058841 : if (! base_specifier)
3668 : {
3669 1058841 : widest_int wdigit = wi::to_widest (m2decl_BuildIntegerConstant (digit));
3670 1058841 : result = wi::umul (result, wbase, &overflow);
3671 1058841 : if (overflow == wi::OVF_NONE)
3672 1058841 : result = wi::add (result, wdigit, UNSIGNED, &overflow);
3673 1058841 : }
3674 1058841 : i++;
3675 : }
3676 603865 : if (overflow == wi::OVF_NONE)
3677 : {
3678 603865 : tree value = wide_int_to_tree (type, result);
3679 603865 : if (m2expr_TreeOverflow (value))
3680 : {
3681 0 : if (issueError)
3682 0 : error_at (location,
3683 : "constant literal %qs exceeds internal ZTYPE range", str);
3684 0 : return true;
3685 : }
3686 : return false;
3687 : }
3688 : else
3689 : {
3690 0 : if (issueError)
3691 0 : error_at (location,
3692 : "constant literal %qs exceeds internal ZTYPE range", str);
3693 0 : return true;
3694 : }
3695 603865 : }
3696 :
3697 :
3698 : /* StrToWideInt return true if an overflow occurs when attempting to convert
3699 : str to an unsigned ZTYPE the value is contained in the widest_int result.
3700 : The value result is undefined if true is returned. */
3701 :
3702 : bool
3703 603865 : m2expr_StrToWideInt (location_t location, const char *str, unsigned int base,
3704 : widest_int &result, bool issueError)
3705 : {
3706 603865 : if (m2expr_OverflowZType (location, str, base, issueError))
3707 : return true;
3708 603865 : return ToWideInt (location, str, base, result, issueError);
3709 : }
3710 :
3711 :
3712 : /* GetSizeOfInBits return the number of bits used to contain, type. */
3713 :
3714 : tree
3715 280 : m2expr_GetSizeOfInBits (tree type)
3716 : {
3717 512 : enum tree_code code = TREE_CODE (type);
3718 :
3719 512 : if (code == FUNCTION_TYPE)
3720 0 : return m2expr_GetSizeOfInBits (ptr_type_node);
3721 :
3722 : if (code == VOID_TYPE)
3723 : {
3724 0 : error ("%qs applied to a void type", "sizeof");
3725 0 : return size_one_node;
3726 : }
3727 :
3728 : if (code == VAR_DECL)
3729 0 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
3730 :
3731 : if (code == PARM_DECL)
3732 0 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
3733 :
3734 : if (code == TYPE_DECL)
3735 232 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
3736 :
3737 : if (code == COMPONENT_REF)
3738 0 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
3739 :
3740 : if (code == ERROR_MARK)
3741 0 : return size_one_node;
3742 :
3743 280 : if (!COMPLETE_TYPE_P (type))
3744 : {
3745 0 : error ("%qs applied to an incomplete type", "sizeof");
3746 0 : return size_zero_node;
3747 : }
3748 :
3749 280 : return m2decl_BuildIntegerConstant (TYPE_PRECISION (type));
3750 : }
3751 :
3752 : /* GetSizeOf taken from c-typeck.cc (c_sizeof). */
3753 :
3754 : tree
3755 10235116 : m2expr_GetSizeOf (location_t location, tree type)
3756 : {
3757 10407964 : enum tree_code code = TREE_CODE (type);
3758 10407964 : m2assert_AssertLocation (location);
3759 :
3760 10407964 : if (code == FUNCTION_TYPE)
3761 0 : return m2expr_GetSizeOf (location, m2type_GetPointerType ());
3762 :
3763 : if (code == VOID_TYPE)
3764 0 : return size_one_node;
3765 :
3766 : if (code == VAR_DECL)
3767 2988 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
3768 :
3769 : if (code == PARM_DECL)
3770 114 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
3771 :
3772 : if (code == TYPE_DECL)
3773 169722 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
3774 :
3775 : if (code == ERROR_MARK)
3776 42 : return size_one_node;
3777 :
3778 : if (code == CONSTRUCTOR)
3779 0 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
3780 :
3781 : if (code == FIELD_DECL)
3782 0 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
3783 :
3784 : if (code == COMPONENT_REF)
3785 24 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
3786 :
3787 10235074 : if (!COMPLETE_TYPE_P (type))
3788 : {
3789 0 : error_at (location, "%qs applied to an incomplete type", "SIZE");
3790 0 : return size_zero_node;
3791 : }
3792 :
3793 : /* Convert in case a char is more than one unit. */
3794 20470148 : return size_binop_loc (
3795 10235074 : location, CEIL_DIV_EXPR, TYPE_SIZE_UNIT (type),
3796 10235074 : size_int (TYPE_PRECISION (char_type_node) / BITS_PER_UNIT));
3797 : }
3798 :
3799 : tree
3800 569588 : m2expr_GetIntegerZero (location_t location ATTRIBUTE_UNUSED)
3801 : {
3802 569588 : return integer_zero_node;
3803 : }
3804 :
3805 : tree
3806 64636 : m2expr_GetIntegerOne (location_t location ATTRIBUTE_UNUSED)
3807 : {
3808 64636 : return integer_one_node;
3809 : }
3810 :
3811 : tree
3812 61144 : m2expr_GetCardinalOne (location_t location)
3813 : {
3814 61144 : return m2convert_ToCardinal (location, integer_one_node);
3815 : }
3816 :
3817 : tree
3818 94860 : m2expr_GetCardinalZero (location_t location)
3819 : {
3820 94860 : return m2convert_ToCardinal (location, integer_zero_node);
3821 : }
3822 :
3823 : tree
3824 1466 : m2expr_GetWordZero (location_t location)
3825 : {
3826 1466 : return m2convert_ToWord (location, integer_zero_node);
3827 : }
3828 :
3829 : tree
3830 506034 : m2expr_GetWordOne (location_t location)
3831 : {
3832 506034 : return m2convert_ToWord (location, integer_one_node);
3833 : }
3834 :
3835 : tree
3836 66540 : m2expr_GetPointerZero (location_t location)
3837 : {
3838 66540 : return m2convert_convertToPtr (location, integer_zero_node);
3839 : }
3840 :
3841 : tree
3842 14952 : m2expr_GetPointerOne (location_t location)
3843 : {
3844 14952 : return m2convert_convertToPtr (location, integer_one_node);
3845 : }
3846 :
3847 : tree
3848 0 : m2expr_GetBitsetZero (location_t location)
3849 : {
3850 0 : return m2convert_ToBitset (location, integer_zero_node);
3851 : }
3852 :
3853 : /* build_set_full_complement return a word size value with all bits
3854 : set to one. */
3855 :
3856 : static tree
3857 14952 : build_set_full_complement (location_t location)
3858 : {
3859 14952 : tree value = integer_zero_node;
3860 14952 : int i;
3861 :
3862 14952 : m2assert_AssertLocation (location);
3863 :
3864 508368 : for (i = 0; i < SET_WORD_SIZE; i++)
3865 : {
3866 478464 : value = m2expr_BuildLogicalOr (
3867 : location, value,
3868 : m2expr_BuildLSL (
3869 : location, m2expr_GetWordOne (location),
3870 : m2convert_BuildConvert (location, m2type_GetWordType (),
3871 : m2decl_BuildIntegerConstant (i), false),
3872 : false));
3873 : }
3874 14952 : return value;
3875 : }
3876 :
3877 : /* GetRValue returns the rvalue of expr. The type is the object
3878 : type to be copied upon indirection. */
3879 :
3880 : tree
3881 10564 : m2expr_GetRValue (location_t location, tree expr, tree type, bool islvalue)
3882 : {
3883 10564 : if (islvalue)
3884 1772 : return m2expr_BuildIndirect (location, expr, type);
3885 : else
3886 : return expr;
3887 : }
3888 :
3889 :
3890 : /* GetCstInteger return the integer value of the cst tree. */
3891 :
3892 : int
3893 5308 : m2expr_GetCstInteger (tree cst)
3894 : {
3895 5308 : return TREE_INT_CST_LOW (cst);
3896 : }
3897 :
3898 :
3899 : /* init initialise this module. */
3900 :
3901 : void
3902 14952 : m2expr_init (location_t location)
3903 : {
3904 14952 : m2assert_AssertLocation (location);
3905 :
3906 14952 : set_full_complement = build_set_full_complement (location);
3907 14952 : }
3908 :
3909 : #include "gt-m2-m2expr.h"
|
